home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / node2src.zip / RBBSSUB4.BAS < prev    next >
BASIC Source File  |  1990-12-31  |  110KB  |  2,994 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB4.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB4.BAS
  5. '  First Released .....: February 4, 1990
  6. '  Subsequent Releases.:
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  AnyBut         59760  Determine where a "word" begins
  18. '  AskUsers       64003  Ask users questions based on a script and save answers
  19. '  AskMore        59858  Check whether screen full
  20. '  AutoPage       60300  Check whether to notify sysop caller is on
  21. ' BadFileChar     59800  Check file name for bad character
  22. '  Bracket        59960  Puts strings around a substring
  23. '  BufFile        58400  Write a file to the user quickly
  24. '  BufString      58300  Write a string with imbedded CR/LF to the user quickly
  25. '  CheckColor     59930  Highlighting based on search string
  26. '  SearchArray    58190  Check for the occurance of a string in an array
  27. '  ColorDir       59920  Adds colorization to FMS directory entry
  28. '  ColorPrompt    59940  Colorizes prompts
  29. '  CompDate       59880+ Produces a computational data from YY, MM, DD
  30. '  ConfMail       59854  Check conference mail waiting
  31. '  ConvertDir     58950  Checks for U & A (shorthand) and converts appropriately
  32. '  PackDate       59201  Compress date in string format to 2 characters
  33. '  EofComm        60000  Determine whether any chars in comm port buffer
  34. '  ExpireDate     59890  Calculate registration expiration date
  35. '  FakeXRpt       62650  Write out file transfer report for protocols that don't
  36. '  FindEnd        58770  Find where a "word" ends
  37. '  FindFile       58790  Determine whether a file exists without opening it
  38. '  FindLast       58600  Find last occurence of a string
  39. '  FMS            58200  Search the upload management system for entries
  40. '  GetAll         59780  Get list of all directories to display
  41. '  GetDirs        58895  Prompts for directories for file list/new/search cmds
  42. '  GetMsgAttr     62530  Restore attributes of original message
  43. '  GetYMD         59204  Pulls YY, MM, or DD from a 2 byte stored date
  44. '  GlobalSrchRepl 60100  Global search and replace
  45. '  LogPDown       59400  Records download in private directory
  46. '  MarkTime       60200  Give visual feedback during lengthy process
  47. '  MetaGSR        60130  Meta statement global search and replace
  48. '  MsgImport      59698  Allow local user to import a text file to a message
  49. '  Muzak          59100  Play musical themes for different RBBS functions
  50. '  NewPassword    60668  Get a new password
  51. '  PersFile       59300  View and select personal files for downloading
  52. '  Protocol       62600  Determine if external protocols are available
  53. '  PutMsgAttr     62520  Save attributes of original message
  54. '  Remove         58210  Remove characters from within strings
  55. '  RotorsDir      58700  Searches for a file using list of subdirs
  56. '  RptTime        62540  Report date/time and time on
  57. '  SetEcho        59600  Set RBBS properly for who is to echo
  58. '  SetHiLite      59934  Set user preference on highlighting
  59. '  SetGraphic     59980  Sets graphic preference for text file display
  60. '  SmartText      58250  Process SMART TEXT control strings
  61. '  SubMenu        59500  Processes options that have sub-menus
  62. '  TimedOut       63000  Write timed exit semaphore file
  63. '  TimeLock       60150  Check for TIME LOCK on certain features
  64. '  Transfer       62624  RBBS-PC support for external protocols for file transfer
  65. '  Toggle         57000  Toggles or views user options
  66. ' TwoByteDate     59200  Reduces a data to 2 byte string for space compression
  67. '  UnPackDate     59902  Uncompresses a 2 byte date
  68. '  UserColor      59965  Lets user set color for text and whether bold
  69. '  UserFace       59450  Processes programmable user interface
  70. '  ViewArc        64600  Display .ARC file contents to user
  71. '  PrivDoorRtn    62629  Private door exit routine
  72. '  WipeLine       58800  Wipes away a line so next prints in its place
  73. '  WordWrap       59710  Adjust a msg -- wrap lines and perserve paragraphs
  74. '
  75. '  $INCLUDE: 'RBBS-VAR.BAS'
  76. '
  77. 57000 ' $SUBTITLE: 'Toggle - Toggle User Preferences'
  78. ' $PAGE
  79. '
  80. '  NAME    -- Toggle
  81. '
  82. '  INPUTS  -- ToggleOption      Option to toggle or view
  83. '                               according to the following:
  84. '    ToggleOption         PREFERENCE
  85. '   Toggle   VIEW
  86. '     1       -1           Autodownload
  87. '     2       -2           Bulletin review on logon
  88. '     3       -3           Case change
  89. '     4       -4           File review on logon
  90. '     5       -5           Highlight
  91. '     6       -6           Line feeds
  92. '     7       -7           Nulls
  93. '     8       -8           TurboKey
  94. '     9       -9           Expert
  95. '    10      -10           Bell
  96. '
  97. '  OUTPUTS -- ZSubParm   passed from TPut
  98. '
  99. '  PURPOSE -- Sets or views any single user preference value
  100. '
  101.       SUB Toggle (ToggleOption) STATIC
  102.       ZSubParm = 0
  103.       IF ToggleOption < 0 THEN _
  104.          GOTO 57005
  105.       ON ToggleOption GOSUB _
  106.          57010, _         'Autodownload
  107.          57120, _         'Bulletin review on logon
  108.          57260, _         'Case change
  109.          57150, _         'File review on logon
  110.          57040, _         'Highlight
  111.          57100, _         'Line feeds
  112.          57210, _         'Nulls
  113.          57230, _         'TurboKey
  114.          57190, _         'Expert
  115.          57170            'Bell
  116.       EXIT SUB
  117. 57005 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
  118.       ON -ToggleOption GOSUB _
  119.          57030, _         'Autodownload
  120.          57130, _         'Bulletin review on logon
  121.          57270, _         'Case change
  122.          57160, _         'File review on logon
  123.          57050, _         'Highlight
  124.          57110, _         'Line feeds
  125.          57220, _         'Nulls
  126.          57240, _         'TurboKey
  127.          57200, _         'Expert
  128.          57180            'Bell
  129.       EXIT SUB
  130. 57010 'IF ZAutoDownDesired THEN _
  131.       '   GOTO 57020
  132.       'IF NOT ZAutoDownVerified THEN _
  133.       '   CALL TestUser
  134.       'IF NOT ZAutoDownYes THEN
  135.    CALL QuickTPut1 ("AUTODOWNLOAD Not Supported--- Use a BATCH Protocol") : _
  136.          ZAutoDownDesired = ZTrue
  137. 57020 ZAutoDownDesired = NOT ZAutoDownDesired
  138. 57030 ZOutTxt$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
  139.      CALL QuickTPut1 (ZOutTxt$)
  140.      RETURN
  141. 57040 IF ZEmphasizeOnDef$ = "" THEN _
  142.         CALL QuickTPut1 ("Highlighting unavailable") : _
  143.         RETURN
  144.      IF NOT ZHiLiteOff THEN _
  145.         CALL QuickTPut (ZColorReset$,0)
  146.      CALL SetHiLite (NOT ZHiLiteOff)
  147.      GOSUB 57050
  148.      CALL UserColor
  149.      RETURN
  150. 57050 IF ZEmphasizeOn$ <> "" THEN _
  151.         ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  152.         ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  153.      CALL QuickTPut1 (ZEmphasizeOn$ + "Highlighting" + ZEmphasizeOff$ + _
  154.                  " " + FNOffOn$(NOT ZHiLiteOff))
  155.      RETURN
  156. 57100 ZLineFeeds = NOT ZLineFeeds
  157.       IF ZLocalUser THEN _
  158.          ZLineFeeds = ZTrue
  159. 57110 CALL QuickTPut1 ("Line Feeds " + FNOffOn$(ZLineFeeds))
  160.       CALL SetCrLf
  161.       RETURN
  162. 57120 ZCheckBulletLogon = NOT ZCheckBulletLogon
  163. 57130 ZOutTxt$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  164.            " old BULLETINS in logon"
  165.       CALL QuickTPut1 (ZOutTxt$)
  166.       RETURN
  167. 57150 ZSkipFilesLogon = NOT ZSkipFilesLogon
  168. 57160 ZOutTxt$ = MID$("CHECKSKIP",1 -5 * ZSkipFilesLogon,5) + _
  169.            " new files in logon"
  170.       CALL QuickTPut1 (ZOutTxt$)
  171.       RETURN
  172. 57170 ZPromptBell = NOT ZPromptBell
  173. 57180 ZOutTxt$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  174.       CALL QuickTPut1 (ZOutTxt$)
  175.       RETURN
  176. 57190 ZExpertUser = NOT ZExpertUser
  177.       CALL SetExpert
  178. 57200 ZOutTxt$ = MID$("NoviceExpert",1 -6 * ZExpertUser,6)
  179.       CALL QuickTPut1 (ZOutTxt$)
  180.       RETURN
  181. 57210 ZNulls = NOT ZNulls
  182.       ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
  183.       CALL SetCrLf
  184. 57220 ZOutTxt$ = "Nulls " + FNOffOn$(ZNulls)
  185.       CALL QuickTPut1 (ZOutTxt$)
  186.       RETURN
  187. 57230 ZTurboKeyUser = NOT ZTurboKeyUser
  188. 57240 CALL QuickTPut1 ("TurboKey " + FNOffOn$(ZTurboKeyUser))
  189.       RETURN
  190. 57260 ZUpperCase = NOT ZUpperCase
  191. 57270 ZOutTxt$ = "UPPER CASE " + _
  192.             MID$("and lowerONLY",1 - 9 * ZUpperCase,9)
  193.       CALL QuickTPut1 (ZOutTxt$)
  194. 57280 ZUseTPut = (ZUpperCase OR ZXOnXOff)
  195.       RETURN
  196.       END SUB
  197. '
  198. 58190 ' $SUBTITLE: 'SearchArray - subroutine to check for a string in an array'
  199. ' $PAGE
  200. '
  201. '  NAME    -- SearchArray
  202. '
  203. '  INPUTS  -- PARAMETER                      MEANING
  204. '             Element$                THE STRING TO CHECK FOR
  205. '             Array$()                THE ARRAY TO BE SEARCHED
  206. '             NumEntriesToSearch      NUMBER OF ENTRIES WITHIN IN
  207. '                                     THE ARRAY TO BE SEARCHED
  208. '
  209. '  OUTPUTS -- IsInAra                 0 = STRING NOT Found IN THE
  210. '                                         ARRAY SPECIFIED
  211. '                                     OTHERWISE IT IS THE NUMBER sOF
  212. '                                     ELEMENT WITHIN THE ARRAY THAT
  213. '                                     WAS Found TO MATCH
  214. '
  215. '  PURPOSE -- Search an array for a specified string and, if found,
  216. '             return the number of the element that matched.
  217. '
  218.       SUB SearchArray (Element$,Array$(1),NumEntriesToSearch,IsInAra) STATIC
  219.       IsInAra = 1
  220.       CALL AllCaps (Element$)
  221.       MaxTries = NumEntriesToSearch + 1
  222.       Array$(MaxTries) = Element$
  223.       WHILE Array$(IsInAra) <> Element$
  224.          IsInAra = IsInAra + 1
  225.       WEND
  226.       IF IsInAra = MaxTries THEN _
  227.          IsInAra = 0
  228.       END SUB
  229. 58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system'
  230. ' $PAGE
  231. '
  232. '  NAME    -- FMS
  233. '
  234. '  INPUTS  -- PARAMETER                      MEANING
  235. '             DirToSearch$          RBBS-PC "DIR" CATEGORY TO LOOK
  236. '                                     FOR
  237. '             SearchString$          STRING TO SEARCH FOR
  238. '             SearchDate$            DATE TO SEARCH FOR
  239. '             ZCategoryName$()
  240. '             ZCategoryCode$()
  241. '             ZCategoryDesc$()
  242. '             CatFound
  243. '             ZNumCategories
  244. '
  245. '  OUTPUTS -- ProcessedInFMS
  246. '             DnldFlag
  247. '
  248. '  PURPOSE -- To search the file management system and display the
  249. '             files being searched for as well as the catetory descriptions
  250. '
  251.       SUB FMS (DirToSearch$,SearchString$,SearchDate$, _
  252.                ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _
  253.                ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC
  254.       DnldFlag = 0
  255.       CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound)
  256.       ProcessedInFMS = ProcessedInFMS OR (CatFound > 0)
  257. '****************************** TELL THEM mod *****************************  ' Bh
  258. '
  259.      ZNotify$ =  ZWelcomeFileDrvPath$ + _
  260.          "HAPPY.DEF"                              'Pe 06/12/89
  261.     ZStopInterrupts = ZTrue                         'Pe 06/12/89
  262.     CALL BUFFILE (ZNotify$,WasX)                    'Pe 06/12/89
  263. '
  264. '**********************  END OF MOD  **************************************  ' Bh
  265. IF ZFG4$ <> "" THEN _
  266.     FG5$ = ZEscape$ + "[1;34;40m" : _
  267.     FG6$ = ZEscape$ + "[1;37;41m" : _
  268.     FG7$ = ZEscape$ + "[1;37;44m"         'Pe 02/05/90
  269.      IF ProcessedInFMS THEN _
  270.      ZSubParm = 5 : _
  271.      GOSUB 58202 : _
  272. '         CALL QuickTPut(FG5$+"╔═"+FG6$+" "+DirToSearch$+" "+FG5$+"═══",0) : _   ' Bh 090690
  273.          CALL QuickTPut("",1) : _
  274.          CALL QuickTPut("╔═ " + DirToSearch$+" ═══",0) : _                ' Bh 090890
  275.          CALL QuickTPut(" "+ ZCategoryDesc$(CatFound) +" " + FG5$ + "════" + _
  276.                     +" " +  SrchDir$,1) : _
  277.          CALL QuickTPut("║",1)  : _
  278. '         CALL QuickTPut("╚═"+FG7$+"File Name"+FG5$+"═════" + FG7$ + "Size" + _          ' Bh 082990
  279. '                    FG5$+"═════",0) : _
  280. '         CALL QuickTPut(FG7$+"Date"+FG5$+"════"+FG7$ + "Description"+ _
  281. '              FG5$+"════════════════════════════"+ZFG3$+" "+ZEmphasizeOff$,1) : _
  282. '         CALL QuickTPut("╚═"+FG7$+"File Name"+FG5$+"═══" + FG7$ + "Size" + _          ' Bh 082990
  283. '                    FG5$+"══",0) : _
  284. '         CALL QuickTPut(FG7$+"Date"+FG5$+"═ "+FG7$ + "+ means that"+ _
  285. '              FG5$+" there is extra information "+ZFG3$+" "+ZCrLf$+ZEmphasizeOff$,1) : _
  286.          CALL QuickTPut("╚═File Name═══Size" + _          ' Bh 082990
  287.                     "══",0) : _
  288.          CALL QuickTPut("Date (+ here means"+ _
  289.               " extra info is available) ═══ "+ZCrLf$+ZEmphasizeOff$,1) : _
  290.          Cat$ = ZCategoryCode$(CatFound) : _
  291.      CALL DispUpDir (CAT$,SearchString$,SearchDate$,DnldFlag,AbortIndex)
  292.       EXIT SUB
  293. 58202 ZOutTxt$ = SearchDate$
  294.       IF LEN(ZOutTxt$) > 0 THEN _
  295.          ZOutTxt$ = MID$(ZOutTxt$,3) + LEFT$(ZOutTxt$,2)
  296.       SrchDir$ = SearchString$ + _
  297.              ZOutTxt$
  298.       IF SrchDir$ <> "" THEN _
  299.           SrchDir$ = ZFG4$ + "Scanning for "  + ZFG2$ + SrchDir$
  300.       RETURN
  301.       END SUB
  302. 58210 ' $SUBTITLE: 'Remove - subroutine to delete a string from within a string'
  303. ' $PAGE
  304. '
  305. '  NAME    -- Remove
  306. '
  307. '  INPUTS  -- PARAMETER                      MEANING
  308. '             BADSTRING$              STRING CONTAINING CHARACTERS
  309. '                                     TO BE DELETED FROM "WasL$"
  310. '             WasL$                      STRING TO BE ALTERED
  311. '
  312. '  OUTPUTS -- WasL$                      WITH THE CHARACTERS IN
  313. '                                     "BADSTRING#" DELETED FROM IT
  314. '
  315. '  PURPOSE -- To remove all instances of the characters in
  316. '                        "BADSTRING$" from "WasL$"
  317. '
  318.       SUB Remove (WasL$,BadString$) STATIC
  319.       WasJ = 0
  320.       FOR WasI=1 TO LEN(WasL$)
  321.          IF INSTR(BadString$,MID$(WasL$,WasI,1)) = 0 THEN _
  322.             WasJ = WasJ + 1 : _
  323.             MID$(WasL$,WasJ,1) = MID$(WasL$,WasI,1)
  324.       NEXT WasI
  325.       WasL$ = LEFT$(WasL$,WasJ)
  326.       END SUB
  327. ' Removes full strings from other strings
  328. '
  329.       SUB UnString(WasL$,BadString$) STATIC
  330.       WasI = INSTR(WasL$,BadString$)
  331.       WHILE WasI <> 0
  332.          WasL$ = LEFT$(WasL$,WasI-1) + MID$(WasL$,WasI+LEN(BadString$))
  333.          WasI = INSTR(WasL$,BadString$)
  334.       WEND
  335.       END SUB
  336. '
  337. 58250 ' $SUBTITLE: 'SmartText - smart text substitution'
  338. ' $PAGE
  339. '
  340. '  NAME    -- SmartText   (WRITTEN BY DOUG AZZARITO)
  341. '
  342. '  INPUTS  -- StringWork$        string to scan for Smart Text
  343. '             CRFound            Does this line contain a CR?
  344. '             ZSmartTextCode     Smart Text control code
  345. '
  346. '  OUTPUTS -- StringWork$        Input string with Smart replaced
  347. '
  348. '  PURPOSE -- Smart Text allows control strings in text files
  349. '             to be replaced at runtime with user info or other
  350. '             data.  The Smart Text control code is a 1-byte
  351. '             code (configurable) with a 2-byte action code.
  352. '
  353.       SUB SmartText (StringWork$, CRFound, OverStrike) STATIC
  354.       IF SmartCarry$<>"" THEN _
  355.          StringWork$ = SmartCarry$+StringWork$
  356.       Index = INSTR(StringWork$, ZSmartTextCode$)
  357.       WHILE Index > 0 AND Index < LEN(StringWork$)-1
  358.          IF INSTR(MID$(StringWork$, Index+1,2)," ") THEN _
  359.             SmartAct = 0 _
  360.          ELSE _
  361.             SmartAct = INSTR(ZSmartTable$, MID$(StringWork$, Index+1, 2))
  362.          IF SmartAct = 0 THEN _
  363.             WasI = 1 : _
  364.             GOTO 58254
  365.          SmartAct = (SmartAct+2)/3
  366.          ON SmartAct GOSUB 58260, 58261, 58262, 58263, 58264, 58265, _
  367.                            58266, 58267, 58268, 58269, 58270, _
  368.                            58271, 58272, 58273, 58274, 58275, _
  369.                            58276, 58277, 58278, 58279, 58280, _
  370.                            58281, 58282, 58283, 58284, 58285, _
  371.                            58286, 58287, 58289, 58290, 58291, _
  372.                            58292, 58293, 58294, 58295            'DGS-STAMod
  373.          GOSUB 58256
  374.          WasI = LEN(SmartHold$)
  375.          ReplaceLen = 3
  376.          IF OverStrike OR Overlay THEN _
  377.             IF WasI > 2 THEN _
  378.                ReplaceLen = WasI _
  379.             ELSE _
  380.                SmartHold$ = SmartHold$ + SPACE$(3 - WasI)
  381.          StringWork$ = LEFT$(StringWork$, Index-1) + SmartHold$ + _
  382.                        MID$(StringWork$,Index+ReplaceLen)
  383. 58254    Index = INSTR(Index+WasI, StringWork$, ZSmartTextCode$)
  384.       WEND
  385.       IF Index AND (Index > LEN(StringWork$)-2) AND NOT CRFound THEN _
  386.          SmartCarry$ = MID$(StringWork$,Index) : _
  387.          StringWork$ = LEFT$(StringWork$,Index-1) : _
  388.       ELSE _
  389.          SmartCarry$ = ""
  390.       EXIT SUB
  391. 58256 IF TrimSmart THEN _
  392.          CALL Trim (SmartHold$)
  393.       RETURN
  394. 58258 ZLastSmartColor$ = SmartHold$
  395.       RETURN
  396. 58260 ZLinesPrinted = 0                     ' CS (Clear screen line count reset)
  397.       SmartHold$ = ""
  398.       RETURN
  399. 58261 ZLinesPrinted = ZPageLength           ' PB Page Break
  400.       IF ZNonStop THEN _                    ' force a 1-time pause
  401.          ZOneStop = ZTrue : _               ' if NON STOP is on
  402.          ZNonStop = ZFalse
  403.       SmartHold$ = ""
  404.       ZForceKeyboard = ZTrue
  405.       RETURN
  406. 58262 ZNonStop = ZTrue                      ' NS Non-stop
  407.       SmartHold$ = ""
  408.       RETURN
  409. 58263 IF ZGlobalSysop THEN _                ' FN First Name
  410.          SmartHold$ = ZOrigSysopFN$ _
  411.       ELSE SmartHold$ = ZFirstName$
  412.       CALL NameCaps(SmartHold$)
  413.       RETURN
  414. 58264 IF ZGlobalSysop THEN _
  415.          SmartHold$ = ZOrigSysopLN$ _
  416.       ELSE SmartHold$ = ZLastName$
  417.       CALL NameCaps(SmartHold$)
  418.       RETURN
  419. 58265 SmartHold$ = MID$(STR$(ZUserSecLevel),2)   ' SL Security level
  420.       RETURN
  421. 58266 SmartHold$ = DATE$            ' DT Date
  422.       RETURN
  423. 58267 CALL AMorPM
  424.       SmartHold$ = ZTime$           ' TM Time
  425.       RETURN
  426. 58268 CALL TimeRemain(MinsRemaining)
  427.       SmartHold$ = MID$(STR$(INT(MinsRemaining)),2)
  428.       RETURN
  429. 58269 CALL TimeRemain(MinsRemaining)      ' TE Time elapsed (mm:ss)
  430.       SmartHold$ = MID$(STR$(INT(ZSecsUsedSession!/60)),2)+":"+ _
  431.          MID$(STR$((ZSecsUsedSession! MOD 60)+100),3)
  432.       RETURN
  433. 58270 SmartHold$ = MID$(STR$(INT((ZTimeLockSet+0.5)/60)),2) ' TL - Time Lock period
  434.       SmartHold$ = SmartHold$ + ":"+ MID$(STR$((ZTimeLockSet MOD 60)+100),3)
  435.       RETURN
  436. 58271 SmartHold$ = MID$(STR$(ZDaysInRegPeriod),2)
  437.       RETURN                                ' RP Registration Length
  438. 58272 SmartHold$ = MID$(STR$(ZRegDaysRemaining),2)
  439.       RETURN                                ' RR Registration Remaining
  440. 58273 SmartHold$ = ZCityState$              ' CT Users CITY & STATE
  441.       RETURN
  442. 58274 SmartHold$ = ZFG1$                    ' C1 Color 1
  443.       GOTO 58258
  444. 58275 SmartHold$ = ZFG2$                    ' C2 Color 2
  445.       GOTO 58258
  446. 58276 SmartHold$ = ZFG3$                    ' C3 Color 3
  447.       GOTO 58258
  448. 58277 SmartHold$ = ZFG4$                    ' C4 Color 4
  449.       GOTO 58258
  450. 58278 SmartHold$ = ZEmphasizeOff$           ' C0 Reset color
  451.       ZLastSmartColor$ = ""
  452.       RETURN
  453. 58279 SmartHold$ = MID$(STR$(INT(ZDLToday!)),2)
  454.       RETURN                                ' DD files Dnlded TODAY
  455. 58280 SmartHold$ = MID$(STR$(INT(ZBytesToday!)),2)
  456.       RETURN                                ' BD Bytes Dnlded TODAY
  457. 58281 SmartHold$ = MID$(STR$(INT(ZDLBytes!)),2)
  458.       RETURN                                ' DB Download Bytes
  459. 58282 SmartHold$ = MID$(STR$(INT(ZULBytes!)),2)
  460.       RETURN                                ' UB Upload Bytes
  461. 58283 SmartHold$ = MID$(STR$(ZDnlds),2)     ' DL Number of Dnlds
  462.       RETURN
  463. 58284 SmartHold$ = MID$(STR$(ZUplds),2)     ' UL Number of Uplds
  464.       RETURN
  465. 58285 SmartHold$ = ZFileName$               ' FI  File Name
  466.       RETURN
  467. 58286 Overlay = ZTrue                       ' VY Overlay ON
  468.       GOTO 58288
  469. 58287 Overlay = ZFalse                      ' VN Overlay OFF
  470. 58288 SmartHold$ = ""
  471.       RETURN
  472. 58289 TrimSmart = ZTrue                     ' TY Trim Yes
  473.       GOTO 58288
  474. 58290 TrimSmart = ZFalse                    ' TN Trim No
  475.       GOTO 58288
  476. 58291 SmartHold$ = ZRBBSName$               ' BN Board Name
  477.       RETURN
  478. 58292 SmartHold$ = ZNodeID$                 ' ND Node Number
  479.       IF SmartHold$ >= "A" THEN _
  480.          SmartHold$ = MID$(STR$(ASC(SmartHold$) - 54),2)
  481.       RETURN
  482. '58293 SmartHold$ = ZSysopFirstName$          ' FS Sysops First Name  ' Bh 110690
  483. '      CALL NameCaps(SmartHold$)
  484. '      RETURN
  485. 58293 SmartHold$ = ZConfName$               ' FS File Collection     ' Bh 122790
  486.       RETURN
  487. 58294 SmartHold$ = ZSysopLastName$          ' LS Sysops First Name
  488.       CALL NameCaps(SmartHold$)
  489.       RETURN
  490. 58295 SmartHold$ = STR$(ZBaudTest!)         ' BA Baud Rate
  491.       RETURN
  492.       END SUB
  493. '
  494. 58300 ' $SUBTITLE: 'BufString - write a string with imbedded ZCR/LF'
  495. ' $PAGE
  496. '
  497. '  NAME    -- BufString
  498. '
  499. '  INPUTS  -- PARAMETER                      MEANING
  500. '             Strng$                  STRING TO BE WRITTEN OUT
  501. '             DataSize               LENGTH OF STRING - # LEFT
  502. '                                        CHARS TO OUTPUT
  503. '
  504. '  OUTPUTS -- Strng$                  IS WRITTEN TO THE USER
  505. '
  506. '  PURPOSE -- To search the string, Strng$, for embedded carriage
  507. '             returns and line feeds and write out each line with
  508. '             the appropriate substitution (cr/lf if to the local
  509. '             screen or cr/nulls/lf if to the communications port).
  510. '
  511.       SUB BufString (Strng$,PassedDataSize,AbortIndex) STATIC
  512.       WasL = LEN(Strng$)
  513.       IF PassedDataSize < WasL THEN _
  514.          WasL = PassedDataSize
  515.       IF WasL < 1 THEN _
  516.          EXIT SUB
  517.       ZFF = ZPageLength - 1
  518.       StartByte = 1
  519.       IF CarryOver THEN _
  520.          IF ASC(Strng$) = 10 THEN _
  521.             StartByte = 2 : _
  522.             CALL SkipLine (1+ZJumpSearching)
  523.       CarryOver = (MID$(Strng$,WasL,1) = ZCarriageReturn$)
  524.       WasL = WasL + CarryOver
  525. 58301 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  526.       IF CRat > 0 AND CRat < WasL THEN _
  527.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  528.       ELSE CRFound = ZFalse
  529.       EOLlen = -2 * CRFound
  530.       IF CRFound THEN _
  531.          EOD = CRat _
  532.       ELSE EOD = WasL + 1
  533.       NumBytes = EOD - StartByte
  534.       StringWork$ = MID$(Strng$,StartByte,NumBytes)
  535.       IF NOT ZDeleteInvalid THEN _
  536.          GOTO 58304
  537.       Index = INSTR(StringWork$,"<")
  538.       WasJ = LEN(StringWork$) - 1
  539.       WHILE Index > 0 AND Index < WasJ
  540.          IF MID$(StringWork$,Index + 2,1) = ">" THEN _
  541.             IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _
  542.                MID$(StringWork$,Index + 1,1) = "*"
  543.          Index = INSTR(Index + 1,StringWork$,"<")
  544.       WEND
  545. 58304 IF ZJumpSearching THEN _
  546.          Temp$ = StringWork$ : _
  547.          CALL AllCaps (Temp$) : _
  548.          HiLitePos = INSTR (Temp$,ZJumpTo$) : _
  549.          IF HiLitePos = 0 THEN _
  550.             GOTO 58307 _
  551.          ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _
  552.               ZJumpSearching = ZFalse
  553.       IF ZSmartTextCode THEN _
  554.          CALL SmartText (StringWork$, CRFound, ZFalse)
  555.       CALL QuickTPut (StringWork$, - (CRFound))
  556.       IF ZRet THEN _
  557.          EXIT SUB
  558.       IF ZLinesPrinted < ZFF THEN _
  559.          GOTO 58307
  560. 58305 CALL CheckTimeRemain (MinsRemaining)
  561.       CALL CheckCarrier
  562.       IF ZSubParm = -1 THEN _
  563.          EXIT SUB
  564.       IF ZNonStop THEN _
  565.          GOTO 58307
  566.       IF NOT CRFound THEN _
  567.          GOTO 58307
  568.       ZForceKeyboard = ZTrue
  569.       CALL AskMore ("",ZTrue,ZFalse,AbortIndex,ZStopInterrupts)
  570.       IF ZNo THEN _
  571.          ZRet = ZTrue : _
  572.          EXIT SUB
  573. 58307 StartByte = EOD + EOLlen
  574.       IF StartByte <= WasL THEN _
  575.          GOTO 58301
  576.       END SUB
  577. 58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user'
  578. ' $PAGE
  579. '
  580. '  NAME    -- BufFile
  581. '
  582. '  INPUTS  -- PARAMETER                      MEANING
  583. '             FileSpec$               NAME OF THE FILE TO WRITE TO
  584. '                                                OUT TO THE USER
  585. '
  586. '  OUTPUTS -- NONE                    FILE IS WRITTEN TO THE USER
  587. '
  588. '  PURPOSE -- To display a sequential file to the user
  589. '
  590.       SUB BufFile (FilName$,AbortIndex) STATIC
  591.       CALL FindIt (FilName$)
  592.       IF NOT ZOK THEN _
  593.          GOTO 58419
  594.       ZNo = ZFalse
  595.       CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize)
  596.       DataSize = ZBufferSize
  597.       FIELD 2, DataSize AS SeqRec$
  598.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  599.       ZJumpLast$ = ""
  600.       ZJumpSearching = ZFalse
  601.       ZJumpSupported = ZTrue
  602. '      IF NOT ZStopInterrupts THEN _         ' Bh 112390
  603. '         IF NOT ZConcatFIles THEN _
  604. '            IF NOT ZNonStop THEN _
  605. '               ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _
  606. '               ZSubParm = 2 : _
  607. '               CALL TPut
  608. IF ZSubParm = -1 THEN _
  609.      EXIT SUB               'Pe 02/09/90
  610.       WasTU = 0
  611. 58405 WasTU = WasTU + 1
  612.       IF WasTU < NumRecs THEN _
  613.          GET 2,WasTU _
  614.       ELSE IF WasTU = NumRecs THEN _
  615.               GET 2,WasTU : _
  616.               WasX = INSTR(SeqRec$,CHR$(26)) : _
  617.               IF WasX = 0 OR WasX > LenLastRec THEN _
  618.                  DataSize = LenLastRec _
  619.               ELSE DataSize = WasX - 1 _
  620.            ELSE GOTO 58419
  621.       IF ZLocalUser THEN _
  622.          GOTO 58406
  623.       CALL EofComm (Char)
  624.       IF Char <> -1 THEN _
  625.          GOTO 58407            ' comm port input
  626. 58406 ZKeyboardStack$ = INKEY$
  627.       IF ZKeyboardStack$ = "" THEN _  ' no keyboard input
  628.          CALL BufString (SeqRec$,DataSize,AbortIndex) : _
  629.          GOTO 58408
  630. 58407 ZOutTxt$ = LEFT$(SeqRec$,DataSize)  ' process comm/keyboard
  631.       ZSubParm = 4
  632.       CALL TPut
  633. 58408 IF ZSubParm <> -1 AND NOT ZRet THEN _
  634.          GOTO 58405
  635. 58419 CLOSE 2
  636.       ZBypassTimeCheck = ZFalse
  637.       ZStopInterrupts = ZFalse
  638.       CALL QuickTPut (ZEmphasizeOff$,0)
  639.       ZJumpSupported = ZFalse
  640.       END SUB
  641. 58600 ' $SUBTITLE: 'FindLast - find last occurence of a string'
  642. ' $PAGE
  643. '
  644. '  NAME    -- FindLast
  645. '
  646. '  INPUTS  -- PARAMETER             MEANING
  647. '              LookIn$           STRING TO LOOK INTO
  648. '              LookFor$          STRING TO SEARCH FOR
  649. '
  650. '  OUTPUTS -- WhereFound        POSITION IN LookIn$ THAT
  651. '                                   LookFor$ Found
  652. '             NumFinds          HOW MANY OCCURENCES IN LookIn$
  653. '
  654. '  PURPOSE -- Finds last occurence of LookFor$ in LookIn$ and
  655. '             returns count of # of occurences.  If none found,
  656. '             both returned parameters are set to 0.
  657. '
  658.       SUB FindLast (LookIn$,LookFor$,WhereFound,NumFinds) STATIC
  659.       WhereFound = INSTR(LookIn$,LookFor$)
  660.       NumFinds = -(WhereFound > 0)
  661.       NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  662.       WHILE NextFound > 0
  663.          NumFinds = NumFinds + 1
  664.          WhereFound = NextFound
  665.          NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  666.       WEND
  667.       END SUB
  668. 58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file'
  669. ' $PAGE
  670. '
  671. '  NAME    -- RotorsDir
  672. '
  673. '  INPUTS  --     PARAMETER                    MEANING
  674. '             FilName$                  FILE NAME TO LOOK FOR
  675. '             SDIR.ARA                  ARRAY OF SUBDIRECTORIES
  676. '             MaxSearch                 MAX # OF SUBDIRECTORIES
  677. '             MarkingTime               WHETHER TO MARK TIME
  678. '
  679. '  OUTPUTS -- FNAME$                    ADD SUBDIRECTORY TO THE
  680. '                                       FILE NAME IF FOUND.  OTHER-
  681. '                                       WISE DON'T.
  682. '             ZOK                       TRUE IF FILE WAS Found
  683. '
  684. '  PURPOSE -- Hunt through a list of subdirectories to determine
  685. '             if a file is in any of them.  If file is found, open
  686. '             the file as file #2, add the drive/path to the file
  687. '             name, and sets ZOK to true.  If file isn't found, set
  688. '             file name to the last subdirectory searched -- which
  689. '             should be the upload subdirectory.
  690. '
  691. '             If the library menu is selected (ZMenuIndex = 6), then
  692. '             only 2 subdirectories are searched. The first being
  693. '             the work disk and the second being the selected
  694. '             library disk.
  695. '
  696.       SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime,PassToMacro$) STATIC
  697.       CALL Carrier
  698.       IF ZSubParm = -1 THEN _   'Pe 01/04/89
  699.       EXIT SUB                              'Pe 01/04/89
  700.       ZOK = ZFalse
  701.       ZDotFlag = ZFalse
  702.       IF MarkingTime THEN _
  703.          CALL QuickTPut ("Searching for "+FilName$,0)
  704.       IF ZMenuIndex = 6 THEN _
  705.          GOTO 58705
  706.       NumSearch = 1
  707.       WasX = 0
  708.       WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _
  709.          SDirAra$(NumSearch) <> ""
  710.          IF MarkingTime THEN _
  711.             CALL MarkTime (WasX)
  712.          WasX$ = SDirAra$(NumSearch) + _
  713.               FilName$
  714.          CALL FindFile (WasX$,ZOK)
  715.          NumSearch = NumSearch + 1
  716.       WEND
  717.       IF ZOK OR NOT ZFastFileSearch THEN _
  718.          GOTO 58710
  719.       CALL OpenRSeq (ZFastFileList$,HighRec,WasX,18)
  720.       IF ZErrCode <> 0 THEN _
  721.          GOTO 58710
  722.       CALL TrimTrail (FilName$,".")
  723.       CALL BinSearch (FilName$,1,12,18,HighRec,RecFoundAt, RecFound$)
  724.        ZOK = (RecFoundAt > 0)
  725.       IF NOT ZOK THEN _
  726.          GOTO 58710
  727.       ZOK = ZFalse
  728.       CALL CheckInt (MID$(RecFound$,13,4))
  729.       IF ZTestedIntValue < 1 THEN _
  730.          GOTO 58710
  731.   CALL OpenRSeq (ZFastFileLocator$,HighRec,WasX,66)
  732.       IF ZErrCode <> 0 OR ZTestedIntValue > HighRec THEN _
  733.          GOTO 58710
  734.       FIELD 2, 66 AS LocatorRec$
  735.       GET 2, ZTestedIntValue
  736.       WasX$ = LEFT$(LocatorRec$,63)
  737.       CALL Trim (WasX$)
  738.       IF LEFT$(WasX$,2) = "M!" THEN _
  739.          ZOK = ZFalse : _
  740.          ZGSRAra$(1) = PassToMacro$ : _
  741.          WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _
  742.          CALL Trim (WasX$) : _
  743.          ZFileLocation$ = "" : _
  744.          CALL MacroExe (WasX$) : _
  745.          IF ZFileLocation$ = "" THEN _
  746.             ZOK = ZFalse : _
  747.             GOTO 58711 _
  748.          ELSE WasX$ = ZFileLocation$
  749.       WasX$ = WasX$ + FilName$
  750.       CALL FindFile (WasX$,ZOK)
  751.       GOTO 58710
  752. 58705 WasX$ = ZLibWorkDiskPath$ + _
  753.            FilName$
  754.       CALL FindIt (WasX$)
  755.       IF ZOK THEN _
  756.          GOTO 58710
  757.       WasX$ = ZLibDrive$ + _
  758.            FilName$
  759.       CALL FindIt (WasX$)
  760. 58710 FilName$ = WasX$
  761. 58711 CALL SkipLine (-MarkingTime)
  762.       END SUB
  763. 58800 ' $SUBTITLE: 'WipeLine - Wipe away a line so next overprints'
  764. ' $PAGE
  765. '
  766. '  NAME    -- WipeLine
  767. '
  768. '  INPUTS  --     PARAMETER                    MEANING
  769. '                 ZCarriageReturn$
  770. '                 CharsToWipe            # OF CHARACTERS TO BLANK
  771. '                 ZNulls
  772. '
  773. '  OUTPUTS -- NONE
  774. '
  775. '  PURPOSE -- Wipe away a line and leave cursor at beginning of the
  776. '             same line so that the next line will print in its place
  777. '
  778.       SUB WipeLine (CharsToWipe) STATIC
  779.       IF ZNulls OR CharsToWipe > 79 THEN _
  780.          CALL SkipLine (1) : _
  781.          EXIT SUB
  782.       IF NOT ZLocalUser THEN _
  783.          Strng$ = ZCarriageReturn$ + SPACE$(CharsToWipe) + ZCarriageReturn$ : _
  784.          PRINT #3,Strng$
  785.       IF ZSnoop THEN _
  786.          LOCATE ,1 :  _
  787.          CALL LPrnt(SPACE$(CharsToWipe),0) : _
  788.          LOCATE ,1
  789.       IF ZF7Msg$ = "" OR _
  790.          ZF7Msg$ = "NONE" OR _
  791.          NOT ZSysopNext THEN _
  792.          EXIT SUB
  793.       ZBypassTimeCheck = ZTrue
  794.       CALL BufFile (ZF7Msg$,WasX)
  795.       END SUB
  796. 58895 ' $SUBTITLE: 'GetDirs -- Prompt for directories to search'
  797. ' $PAGE
  798. '
  799. '  NAME    -- GetDirs
  800. '
  801. '  INPUTS  --     PARAMETER                    MEANING
  802. '                 ZDirPrompt$             BASE OF DIRECTORY PROMPT
  803. '                 ShowHelp               Whether to display help
  804. '                                            on entry
  805. '  OUTPUTS --     ZUserIn$
  806. '                 ZWasQ
  807. '
  808. '  PURPOSE -- Prompt for directories to search
  809. '
  810.       SUB GetDirs (ShowHelp) STATIC
  811.       IF ShowHelp AND (ZAnsIndex >= ZLastIndex ) THEN _
  812.          GOTO 58902
  813. 58900 ZOutTxt$ = ZDirPrompt$
  814.       ZMacroMin = 2
  815.       CALL PopCmdStack
  816.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  817.          EXIT SUB
  818.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  819.       IF ZUserIn$(ZAnsIndex) = "Q" THEN _
  820.          ZWasQ = 0 : _
  821.          EXIT SUB
  822.       ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
  823.       IF ZWasA = 0 THEN _
  824.          EXIT SUB
  825.       IF ZWasA > 8 THEN _
  826.          IF ZAnsIndex < ZLastIndex THEN _
  827.             GOTO 58900 _
  828.          ELSE GOTO 58902
  829.       IF ZWasA = 7 THEN _
  830.          ZExtendedOff = NOT ZExtendedOff _
  831.       ELSE ZExtendedOff = (ZWasA > 3)
  832.       CALL QuickTPut1 ("Extended directory display "+MID$("ON OFF",1-3*ZExtendedOff,3))
  833.       GOTO 58900
  834. 58902 ZFileName$ = ZCurDirPath$ + ZDirPrefix$ + _
  835.                     "." + ZDirExtension$
  836.       GDefault$ = MID$(" GC",ZWasGR + 1, 1)
  837.       CALL Graphic (GDefault$,ZFileName$)
  838.       CALL BufFile (ZFileName$,ZAnsIndex)
  839.       GOTO 58900
  840.       END SUB
  841. '
  842. 58950 ' $SUBTITLE: 'ConvertDir -- Converts coded response to right directory'
  843. ' $PAGE
  844. '
  845. '  NAME    -- ConvertDir
  846. '
  847. '  INPUTS  --     PARAMETER                    MEANING
  848. '                 Start               ELEMENT TO BEGIN WITH
  849. '                 ZUserIn$            ARRAY TO CONVERT
  850. '                 ZWasQ               Last ELEMENT TO CONVERT
  851. '
  852. '  OUTPUTS --     ZUserIn$            CONVERTED DIRECTORY LIST
  853. '
  854. '  PURPOSE -- Let the user put in a short standard string for a directory
  855. '
  856. '
  857.       SUB ConvertDir (Start) STATIC
  858.       FOR WasI=Start TO ZLastIndex
  859.          CALL AllCaps (ZUserIn$(WasI))
  860.          IF ZUserIn$(WasI)="U" THEN _
  861.             ZUserIn$(WasI) = ZUpldDirCheck$
  862.          IF ZUserIn$(WasI) = "A" THEN _
  863.             ZUserIn$(WasI) = "ALL"
  864.       NEXT
  865.       END SUB
  866. 59200 ' $SUBTITLE: 'TwoByteDate -- subroutine to put date in 2 bytes'
  867. ' $PAGE
  868. '
  869. '  NAME    -- TwoByteDate
  870. '
  871. '  INPUTS  --   PARAMETER     MEANING
  872. '                  Year       FOUR DIGIT YEAR (I.E. 1987)
  873. '                  WasMM      MONTH
  874. '                  WasDD      DAY
  875. '                Result$      LOCATION TO PLACE THE Result
  876. '
  877. '  OUTPUTS -- Result$       TWO BYTE COMPRESSED DATE FOR USE IN
  878. '                           A RANDOM RECORD
  879. '
  880. '  PURPOSE -- Compress a WasY,ZMsgPtr,WasD date into two characters
  881. '
  882.       SUB TwoByteDate (Year,WasMM,WasDD,Result$) STATIC
  883.       Result$ = CHR$(((Year - 1980) * 2) OR - ((WasMM AND 8) <> 0)) + _
  884.                 CHR$((WasMM AND NOT 8) * 32 + WasDD)
  885.       END SUB
  886. 59201 ' $SUBTITLE: 'PackDate -- subroutine to Compress STRING DATE'
  887. ' $PAGE
  888. '
  889. '  NAME    -- PackDate
  890. '
  891. '  INPUTS  --   PARAMETER     MEANING
  892. '                 Strng$    String Date (mm-dd-yyyy)
  893. '
  894. '  OUTPUTS --    Result$    TWO BYTE COMPRESSED DATE FOR USE IN
  895. '                                      A RANDOM RECORD
  896. '
  897. '  PURPOSE -- Compress an 8-character date into two characters
  898. '
  899.       SUB PackDate (Strng$,Result$) STATIC
  900.       IF LEN(Strng$) < 8 THEN _
  901.          EXIT SUB
  902.       Year = VAL(MID$(Strng$,7))
  903.       WasMM = VAL(Strng$)
  904.       WasDD = VAL(MID$(Strng$,4))
  905.       CALL TwoByteDate (Year,WasMM,WasDD,Result$)
  906.       END SUB
  907. 59202 ' $SUBTITLE: 'UnPackDate -- subroutine to UNCompress DATE'
  908. ' $PAGE
  909. '
  910. '  NAME    -- UnPackDate
  911. '
  912. '  INPUTS  --   PARAMETER      MEANING
  913. '             CompressedDate$ Date in 2 byte compressed form
  914. '
  915. '  OUTPUTS --     Year           Year of compressed date
  916. '                 WasMM          Month of compressed date
  917. '                 WasDD          Day of compressed date
  918. '             DisplayDate$       8 char display date (mm-dd-yyyy)
  919. '
  920. '  PURPOSE -- Uncompress a 2 char date to get Y,M,D & display
  921. '
  922.       SUB UnPackDate (CompressedDate$,Year,WasMM,WasDD,DisplayDate$) STATIC
  923.       CALL GetYMD (CompressedDate$,1,Year)
  924.       CALL GetYMD (CompressedDate$,2,WasMM)
  925.       CALL GetYMD (CompressedDate$,3,WasDD)
  926.       DisplayDate$ = RIGHT$("00" + MID$(STR$(WasMM),2),2) + _
  927.                       "-" + _
  928.                       RIGHT$("00" + MID$(STR$(WasDD),2),2) + _
  929.                       "-" + _
  930.                       RIGHT$(STR$(Year),2)
  931.       END SUB
  932. 59204 ' $SUBTITLE: 'GetYMD -- subroutine to unpack a two-byte date'
  933. ' $PAGE
  934. '
  935. '  NAME    -- GetYMD
  936. '
  937. '  INPUTS  --   PARAMETER     MEANING
  938. '                 TwoByte$    PACKED TWO-BYTE DATE FIELD
  939. '                   YMD       1 = YEAR
  940. '                             2 = MONTH
  941. '                             3 = DAY
  942. '                 Result      LOCATION TO PLACE THE Result
  943. '
  944. '  OUTPUTS -- Result        FOUR DIGIT Result OF UNPAKING THE DATE
  945. '
  946. '  PURPOSE -- Unpack a compressed two-byte date field
  947. '
  948.       SUB GetYMD (TwoByte$,YMD,Result) STATIC
  949.       ON YMD GOTO 59206,59210,59215
  950.       EXIT SUB
  951. 59206 Result = (ASC(TwoByte$)AND NOT 1) / 2 + 1980
  952.       EXIT SUB
  953. 59210 Result = FIX((ASC(MID$(TwoByte$,2)) / 32)) OR ((ASC(TwoByte$) AND 1) * 8)
  954.       EXIT SUB
  955. 59215 Result = ASC(MID$(TwoByte$,2)) AND NOT 224
  956.       END SUB
  957. 59300 ' $SUBTITLE: 'PersFile - processes requests for personal files'
  958. ' $PAGE
  959. '
  960. '  NAME    -- PersFile
  961. '
  962. '  INPUTS  --     PARAMETER           MEANING
  963. '                 PersonalCat$     CATEGORY IN DIR FOR CALLER
  964. '                 ZPersonalLen      # CHARS IN PERSONAL CATEGORY
  965. '  OUTPUTS -- NONE UP ZDnlds
  966. '
  967. '  PURPOSE -- Show caller what personal files have for downloading,
  968. '             verify and process requests for downloads
  969. '
  970.       SUB PersFile (PersonalCat$,DnldFlag) STATIC
  971.       CALL QuickTput1 ("No personal files available")
  972.       ZAnsIndex = 0
  973.       ZLastIndex = 0
  974.       END SUB
  975. 59302
  976. 59303
  977. 59304
  978. 59305
  979. 59306
  980. 59308
  981. 59320
  982. 59322
  983. 59323
  984. 59324
  985. 59325
  986. 59327
  987. 59329
  988. 59330
  989. 59332
  990. 59335
  991. 59336
  992. 59338
  993. 59400 SUB LogPDown (PrivateDnld,ZDwnIndex) STATIC
  994.       END SUB
  995. 59450 ' $SUBTITLE: 'UserFace - handles programmable user interface'
  996. ' $PAGE
  997. '
  998. '  NAME    --  UserFace
  999. '
  1000. '  INPUTS  --  PARAMETER                   MEANING
  1001. '              GDefault$            GRAPHICS DEFAULT TO USE
  1002. '              ZCurPUI$             PUI TO USE
  1003. '              ZExpertUser          WHETHER CALL IN EXPERT MODE
  1004. '
  1005. '  OUTPUTS --  ZWasQ
  1006. '              ZUserIn$()
  1007. '              ZWasZ$
  1008. '
  1009. '  PURPOSE --  When sysop overrides RBBS-PC's default user
  1010. '              interface (provides a MAIN.PUT), this routine
  1011. '              reads in the table of specifications, presents
  1012. '              the sysop menu, presents the prompt, verifies
  1013. '              that a valid option has been picked, determines
  1014. '              whether the option is another PUI, and passes
  1015. '              back choices to be processed.
  1016. '
  1017.       SUB UserFace (GDefault$) STATIC
  1018.       END SUB
  1019. 59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus'
  1020. ' $PAGE
  1021. '
  1022. '  NAME    -- SubMenu
  1023. '
  1024. '  INPUTS  --   PARAMETER     MEANING
  1025. '             PassedPrompt$   PROMPT TO DISPLAY
  1026. '             CurMenu$        NOVICE MENU TO DISPLAY
  1027. '             FrontOpt$       DRIVE/PATH/PREFIX OF FILE
  1028. '                             NEEDED FOR TYPED OPTION
  1029. '             BackOpt$        SUFFIX/EXTENSION OF FILE
  1030. '                             NEEDED WITH TYPED OPTION
  1031. '             ReturnOn$       LETTERS CALLING PROGRAM WANTS
  1032. '                             CONTROL ON
  1033. '             GRDefault$      GRAPHICS DEFAULT TO USE
  1034. '             VerifyInMenu    WHETHER VERIFY OPTION IS IN MENU
  1035. '             AllMenuOK       WHETHER CONTROL SHOULD RETURN
  1036. '                             WHEN IN MENU
  1037. '             ZAnsIndex       # OF COMMANDS IN TYPE AHEAD
  1038. '             RequireInMenu   WHETHER OPTION MUST BE IN MENU
  1039. '
  1040. '  OUTPUTS -- ZWasZ$              OPTION PICKED
  1041. '             ZFileName$      NAME OF FILE SUPPORTING OPTION
  1042. '
  1043. '
  1044. '  PURPOSE -- Handles menus - including conference, bulletins,
  1045. '             doors, questionnaires.  Supports sub-menus (i.e.
  1046. '             an option on the menu that invokes another menu)
  1047. '
  1048.       SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _
  1049.                   BackOpt$,ReturnOn$,GRDefault$,VerifyInMenu, _
  1050.                   AllMenuOK,RequireInMenu,BackOpt2$) STATIC
  1051. 59510 ZFileName$ = CurMenu$
  1052.       CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
  1053.       MenuFront$ = MenuDrv$ + WasX$
  1054.       CALL Graphic (GRDefault$,ZFileName$)
  1055.       CurMenuVer$ = ZFileName$
  1056.       ZStopInterrupts = ZFalse
  1057.       IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _
  1058.          GOTO 59520
  1059. 59515 CALL BufFile (CurMenuVer$,ZAnsIndex) 'show menu
  1060. 59520 ZOutTxt$ = PassedPrompt$            'get response
  1061.       CALL PopCmdStack
  1062.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  1063.          EXIT SUB
  1064. 59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1065.       CALL AllCaps (ZWasZ$)
  1066.       IF INSTR(ReturnOn$,ZWasZ$) THEN _  'check whether calling pgm wants
  1067.          EXIT SUB
  1068.       IF INSTR("LH?",ZWasZ$) THEN _       'check whether caller wants help
  1069.          GOTO 59515
  1070.       IF INSTR(ZWasZ$,".") > 0 THEN _
  1071.          GOTO 59532
  1072.       FPre$ = FrontOpt$
  1073.       GOSUB 59538
  1074.       IF (WasBF < 2) AND (NOT ZOK) THEN _
  1075.          FPre$ = MenuDrv$ : _
  1076.          GOSUB 59538 : _
  1077.          IF NOT ZOK THEN _    ' support shared options
  1078.             FPre$ = MenuFront$ : _
  1079.             GOSUB 59538
  1080.       IF NewMenu THEN _
  1081.          NewMenu = ZFalse : _
  1082.          GOTO 59515
  1083.       IF ZOK THEN _
  1084.          EXIT SUB
  1085. 59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _
  1086.          EXIT SUB
  1087.       GOSUB 59547
  1088.       GOTO 59515
  1089. 59538 FilName$ = FPre$ + ZWasZ$
  1090.       CALL BadFile (FilName$,WasBF)
  1091.       IF WasBF > 1 THEN _
  1092.          ZOK = ZFalse : _
  1093.          RETURN
  1094.       ZFileName$ = FilName$ + _
  1095.                    BackOpt$
  1096.       CALL Graphic (GRDefault$,ZFileName$)
  1097.       IF NOT ZOK THEN _
  1098.          IF BackOpt2$ <> "" THEN _
  1099.             ZFileName$ = FilName$ + _
  1100.                          BackOpt2$ : _
  1101.             CALL Graphic (GRDefault$,ZFileName$)
  1102.       IF ZOK THEN _
  1103.          IF ZSysop OR (NOT RequireInMenu) THEN _
  1104.             RETURN _
  1105.          ELSE CALL WordInFile (CurMenu$,ZWasZ$,Found) : _
  1106.               IF Found THEN _
  1107.                  RETURN _
  1108.               ELSE GOTO 59540
  1109.       IF (NOT VerifyInMenu) THEN _
  1110.          GOTO 59540
  1111.       CALL WordInFile (CurMenu$,ZWasZ$,Found)  'verify against menu itself
  1112.       IF Found THEN _
  1113.          IF AllMenuOK THEN _
  1114.             RETURN
  1115. 59540 WasX$ = FPre$ + _
  1116.            ZWasZ$ + _
  1117.            ".MNU" 'check whether option is a menu
  1118.       ZFileName$ = WasX$
  1119.       CALL Graphic (GRDefault$,ZFileName$)
  1120.       IF ZOK THEN _
  1121.          NewMenu = ZTrue : _
  1122.          CurMenuVer$ = ZFileName$ : _
  1123.          CurMenu$ = WasX$ : _
  1124.          CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue) : _
  1125.          MenuFront$ = MenuDrv$ + WasX$ : _
  1126.          RETURN
  1127.       IF VerifyInMenu AND Found AND NOT RequireInMenu THEN _
  1128.          CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _
  1129.                        CurMenu$ + " but not found",1)
  1130.       RETURN
  1131. 59547 CALL QuickTPut1 ("No such option " + ZWasZ$)
  1132.       ZLastIndex = 0
  1133.       RETURN
  1134. 59548 END SUB
  1135. 59600 ' $SUBTITLE: 'SetEcho -- subroutine to reset who echoes'
  1136. ' $PAGE
  1137. '
  1138. '  NAME    -- SetEcho
  1139. '
  1140. '  INPUTS  --   PARAMETER     MEANING
  1141. '               NewEcho$   The new echo option
  1142. '               ZLocalUser
  1143. '
  1144. '  OUTPUTS -- ZRemoteEcho   Whether RBBS is to echo what a
  1145. '                           remote caller types
  1146. '
  1147. '  PURPOSE -- Resets who echos.  "R" is for RBBS to echo.
  1148. '             "I" is for intermediate host to echo.
  1149. '             "C" is for caller's communication pgm to echo.
  1150. '
  1151.       SUB SetEcho (NewEcho$) STATIC
  1152.       IF NewEcho$ = PrevEcho$ THEN _
  1153.          EXIT SUB
  1154.       IF NewEcho$ = "R" THEN _
  1155.          ZRemoteEcho = (NOT ZLocalUser) _
  1156.       ELSE ZRemoteEcho = ZFalse
  1157.       IF ZLocalUser THEN _
  1158.          GOTO 59602
  1159.       IF NewEcho$ = "I" THEN _
  1160.          PRINT #3,ZHostEchoOn$; : _
  1161.          GOTO 59602
  1162.       IF PrevEcho$ = "I" THEN _
  1163.          PRINT #3,ZHostEchoOff$;
  1164. 59602 PrevEcho$ = NewEcho$
  1165.       END SUB
  1166. 59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message'
  1167. ' $PAGE
  1168. '
  1169. '  NAME    -- MsgImport
  1170. '
  1171. '  INPUTS  --   PARAMETER     MEANING
  1172. '               MaxLines     MAXIMUM # OF LINES
  1173. '               MaxLen       MAXIMUM LENGTH OF A LINE
  1174. '               NumLines     NUMBER OF LINES ALREADY IN MESSAGE
  1175. '               LineAra$     ARRAY OF LINES IN MESSAGE
  1176. '
  1177. '  OUTPUTS --   NumLines
  1178. '               LineAra$
  1179. '
  1180. '  PURPOSE -- Allows local user to append a text file to
  1181. '             a message.   Will word wrap if needed.
  1182. '
  1183.       SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC
  1184.       IF NOT (ZLocalUser OR ZSysop) THEN _
  1185.          CALL QuickTPut1 ("Only for SYSOPS/local users") : _
  1186.          EXIT SUB
  1187. 59700 ZOutTxt$ = "Import what file" + ZPressEnter$
  1188.       CALL PopCmdStack
  1189.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1190.          EXIT SUB
  1191.       CALL FindIt (ZUserIn$(ZAnsIndex))
  1192.       IF NOT ZOK THEN _
  1193.          CALL QuickTPut1 (ZUserIn$(ZAnsIndex) + " not found") : _
  1194.          GOTO 59700
  1195.       WHILE NOT EOF(2) AND NumLines < MaxLines
  1196.          NumLines = NumLines + 1
  1197.          LINE INPUT #2,LineAra$(NumLines)
  1198.       WEND
  1199.       CLOSE 2
  1200.       CALL WordWrap (MaxLen,NumLines,LineAra$())
  1201.       END SUB
  1202. 59703 ' $SUBTITLE: 'WordWrap -- subroutine to wrap lines in a message'
  1203. ' $PAGE
  1204. '
  1205. '  NAME    -- WordWrap
  1206. '
  1207. '  INPUTS  --   PARAMETER     MEANING
  1208. '               MaxLen       MAXIMUM LENGTH OF A SINGLE LINE
  1209. '               NumLines     NUMBER OF LINES IN A MESSAGE
  1210. '               LineAra$     ALL THE LINES IN THE MESSAGE
  1211. '
  1212. '  OUTPUTS --   NumLines
  1213. '               LineAra$
  1214. '
  1215. '  PURPOSE -- Batch adjusts a message, wrapping lines if
  1216. '             needed.  Preserves paragraph structure.
  1217. '
  1218.       SUB WordWrap (MaxLen,NumLines,LineAra$(1)) STATIC
  1219.       WasJ = 1
  1220.       WHILE WasJ <= NumLines
  1221.          ReFormatted = ZFalse
  1222. 59704    CALL TrimTrail (LineAra$(WasJ)," ")
  1223.          WasK = LEN(LineAra$(WasJ))
  1224.          IF WasK <= MaxLen THEN _
  1225.             GOTO 59705
  1226.          CALL FindLast (LineAra$(WasJ)," ",LastPos,HowMany)
  1227.          CALL AnyBut (LineAra$(WasJ),1,">",WasX)
  1228.          CALL AnyBut (LineAra$(WasJ+1),1,">",Temp)
  1229.          IF LEFT$(LineAra$(WasJ + 1),2) = "  " OR ((Temp > 0) AND WasX <> Temp) THEN _
  1230.             FOR WasK = NumLines TO WasJ + 1 STEP -1 : _
  1231.                LineAra$(WasK + 1) = LineAra$(WasK) : _
  1232.             NEXT : _
  1233.             NumLines = NumLines + 1 : _
  1234.             LineAra$(WasJ + 1) = ""
  1235.          IF WasX > 1 THEN _
  1236.             IF MID$(LineAra$(WasJ),WasX,1) = " " THEN _
  1237.                WasX = WasX + 1
  1238.          WasX$ = LEFT$(LineAra$(WasJ),WasX-1)
  1239.          IF LastPos < 1 THEN _
  1240.             LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),MaxLen) + MID$(LineAra$(WasJ + 1),WasX) : _
  1241.             LineAra$(WasJ) = LEFT$(LineAra$(WasJ),MaxLen - 1) + "-" _
  1242.          ELSE ZUserIn$ = LEFT$(" ", - (LEN(LineAra$(WasJ + 1)) > 0)) : _
  1243.               LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),LastPos + 1) + ZUserIn$ + MID$(LineAra$(WasJ + 1),WasX) : _
  1244.               LineAra$(WasJ) = LEFT$(LineAra$(WasJ),LastPos - 1)
  1245.          ReFormatted = ZTrue
  1246.          GOTO 59704
  1247. 59705    IF ReFormatted THEN _
  1248.             IF WasJ = NumLines THEN _
  1249.                NumLines = NumLines + 1
  1250.          WasJ = WasJ + 1
  1251.       WEND
  1252.       END SUB
  1253. 59760 ' $SUBTITLE: 'AnyBut -- subroutine to find where a word begins'
  1254. ' $PAGE
  1255. '
  1256. '  NAME    -- AnyBut
  1257. '
  1258. '  INPUTS  --   PARAMETER     MEANING
  1259. '               Strng$        STRING TO SEARCH FOR WORDS
  1260. '               Beg           BYTE POSITION IN Strng$ TO
  1261. '                             BEGIN SEARCHING
  1262. '               SkipChars$    CHARACTERS TO SKIP OVER WHEN
  1263. '                                SEARCHING
  1264. '
  1265. '  OUTPUTS --   WhereIs      BYTES POSITION IN Strng$ WHERE
  1266. '                             WORD BEGINS
  1267. '
  1268. '  PURPOSE -- Parser.   Finds where a "word" begins, where
  1269. '             any character will be accepted as the beginning of a
  1270. '             word except those listed in SKIP.CHAR$
  1271. '
  1272.       SUB AnyBut (Strng$, Beg, SkipChars$, WhereIs) STATIC
  1273.       WasX$ = Strng$ + _
  1274.            CHR$(0)
  1275.       WhereIs = Beg
  1276.       IF WhereIs < 1 THEN _
  1277.          WhereIs = 1
  1278.       WHILE INSTR(SkipChars$, MID$(WasX$, WhereIs, 1)) > 0
  1279.          WhereIs = WhereIs + 1
  1280.       WEND
  1281.       IF WhereIs > LEN(Strng$) THEN _
  1282.          WhereIs = 0
  1283.       END SUB
  1284. 59770 ' $SUBTITLE: 'FindEnd -- subroutine to find where a word ends'
  1285. ' $PAGE
  1286. '
  1287. '  NAME    -- FindEnd
  1288. '
  1289. '  INPUTS  --   PARAMETER     MEANING
  1290. '               Strng$        STRING TO SEARCH FOR WORDS
  1291. '               Beg          POSITION IN Strng$ TO BEGIN SEARCH
  1292. '               StopWith$    CHARACTERS THAT TERMINATE A WORD
  1293. '
  1294. '  OUTPUTS      WhereIs      POSITION IN Strng$ WHERE WORD ENDS
  1295. '                             (I.E. THE Last CHARACTER OF THE WORD)
  1296. '
  1297. '  PURPOSE -- Parser.   Finds where a "word" ends, where
  1298. '             any character will be counted as in a word
  1299. '             except for those in StopWith$ or when the end of
  1300. '             the string is found.
  1301. '
  1302.       SUB FindEnd (Strng$, Beg, StopWith$, WhereIs) STATIC
  1303.       ZWasB = Beg
  1304.       IF ZWasB < 1 THEN _
  1305.          ZWasB = 1
  1306.       IF ZWasB > LEN(Strng$) THEN _
  1307.          WasX$ = StopWith$ _
  1308.       ELSE WasX$ = MID$(Strng$, ZWasB) + _
  1309.                 StopWith$
  1310.       WasI = 1
  1311.       WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1312.       WHILE WasX = 0
  1313.          WasI = WasI + 1
  1314.          WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1315.       WEND
  1316.       WhereIs = WasI - 1 + ZWasB - 1
  1317.       END SUB
  1318. 59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list'
  1319. ' $PAGE
  1320. '
  1321. '  NAME    -- GetAll
  1322. '
  1323. '  INPUTS  --   PARAMETER     MEANING
  1324. '               LookIn$       NAME OF FILE TO SEARCH
  1325. '               DIR.EXT$      MAIN DIRECTORY EXTENSION TO USE
  1326. '               StartPos      Last POSITION USED IN ARRAY
  1327. '
  1328. '  OUTPUTS      StartPos     Last ELEMENT USED IN ARRAY
  1329. '               LoadInto$    ARRAY TO LOAD ELEMENTS Found
  1330. '
  1331. '  PURPOSE -- Creates a list (LoadInto$) of all directories
  1332. '             to be listed when ZWasA)ll is selected for a directory.
  1333. '             All uses config parm, which can be either a single
  1334. '             directory or list of directories (begin with "@").
  1335. '
  1336.       SUB GetAll (LoadInto$(1), StartPos) STATIC
  1337.       IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _
  1338.          StartPos = StartPos + 1 : _
  1339.          LoadInto$(StartPos) = ZMasterDirName$ : _
  1340.          EXIT SUB
  1341.       ZOK = ZFalse
  1342.       IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _
  1343.          CALL FindIt(MID$(ZMasterDirName$,2))
  1344.       IF NOT ZOK THEN _
  1345.          CALL QuickTPut1 ("No dirs defined for A)ll") : _
  1346.          EXIT SUB
  1347.       MaxLoad = UBOUND(LoadInto$, 1)
  1348.       StartSort = StartPos + 1
  1349.       WHILE NOT EOF(2) AND StartPos < MaxLoad
  1350.          LINE INPUT #2, ZOutTxt$
  1351.          StartPos = StartPos + 1
  1352.          LoadInto$(StartPos) = ZOutTxt$
  1353.       WEND
  1354.       CLOSE 2
  1355.       END SUB
  1356. 59800 ' $SUBTITLE: 'BadFileChar -- checks file for illegal char'
  1357. ' $PAGE
  1358. '
  1359. '  NAME    --  BadFileChar
  1360. '
  1361. '  INPUTS  --  PARAMETER         MEANING
  1362. '               FilName$         NAME OF FILE TO CHECK
  1363. '
  1364. '  OUTPUTS --  IsOK            WHETHER NAME OK
  1365. '
  1366. '  PURPOSE --  Part of test for file's existence.  If bad
  1367. '              character in name, can't exist.
  1368. '
  1369.       SUB BadFileChar (FilName$,IsOK) STATIC
  1370.       WasL = LEN(FilName$)
  1371.       IF WasL > 2 THEN _
  1372.          IF INSTR(3,FilName$,":") > 0 THEN _
  1373.             IsOK = ZFalse : _
  1374.             EXIT SUB
  1375.       WasX$ = FilName$ + "="
  1376.       WasI = 1
  1377.       WHILE INSTR("/[]|<>+=;, ?*",MID$(WasX$,WasI,1)) = 0 AND ASC(MID$(WasX$,WasI)) < 128
  1378.          WasI = WasI + 1
  1379.       WEND
  1380.       IsOK = WasI > WasL
  1381.       END SUB
  1382. '
  1383. 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
  1384. ' $PAGE
  1385. '
  1386. '  NAME    -- ConfMail
  1387. '
  1388. '  INPUTS  -- PARAMETER        MEANING
  1389. '         SKIP.CONFIRM         Whether to skip confirm of option
  1390. '         ZConfMailList$       File of user/message pairs to check
  1391. '         ZActiveUserFile$     Active user file (restored on exit)
  1392. '         ZActiveMessageFile$  Active msg file (restored)
  1393. '  OUTPUTS -- None
  1394. '
  1395. '  PURPOSE -- Quicking scans message header record to get
  1396. '             last msg # and user record to get whether any
  1397. '             new mail and last msg read, reports both, using
  1398. '             highlighting if new mail to caller.
  1399. '
  1400.       SUB ConfMail (MailCheckConfirm) STATIC
  1401.       SkipJoinUnjoin = ZNonStop
  1402.       IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
  1403.          CALL FindIt (ZConfMailList$) _
  1404.       ELSE ZOK = ZFalse
  1405.       IF NOT ZOK THEN _
  1406.          EXIT SUB
  1407.       IF MailCheckConfirm THEN _
  1408.          ZOutTxt$ = "Check conferences for mail ([Y],N)" : _
  1409.          ZTurboKey = -ZTurboKeyUser : _
  1410.          CALL PopCmdStack : _
  1411.          IF ZNo OR ZSubParm < 0 THEN _    ' Bh 123190
  1412.             EXIT SUB
  1413.       CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
  1414.       CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
  1415.       CALL SkipLine (1)
  1416.       CALL QuickTPut1 ("Checking Conferences since you were last on...")   ' Bh
  1417.       AnyMail = ZFalse
  1418.       ZStopInterrupts = ZFalse
  1419.       WasA1$ = ZActiveUserFile$
  1420.       MsgFileSave$ = ZActiveMessageFile$
  1421.       TempIndivValue$ = ""
  1422.       UserFileIndexSave = ZUserFileIndex
  1423.       UserRecordHold$ = ZUserRecord$
  1424.       ZOK = ZTrue
  1425. 59852 IF EOF(2) OR NOT ZOK THEN _
  1426.          GOTO 59854
  1427.          CALL ReadAny
  1428.          ZActiveUserFile$ = ZOutTxt$
  1429.          CALL ReadAny
  1430.          IF ZErrCode > 0 THEN _
  1431.             GOTO 59854
  1432.          ZActiveMessageFile$ = ZOutTxt$
  1433.          CALL FindFile (ZActiveUserFile$,ZOK)
  1434.          IF NOT ZOK THEN _
  1435.             GOTO 59854
  1436.          CALL OpenUser (HighestUserRecord)
  1437.          FIELD 5, 128 AS ZUserRecord$
  1438.          CALL FindFile (ZActiveMessageFile$,ZOK)
  1439.          IF NOT ZOK THEN _
  1440.             GOTO 59854
  1441.          CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_
  1442.                         0,0,HighestUserRecord,_
  1443.                         Found,HoldUserFileIndex,ZWasSL)
  1444.          IF NOT Found THEN _
  1445.             GOTO 59852
  1446.          CALL OpenMsg
  1447.          FIELD 1, 128 AS ZMsgRec$
  1448.          GET 1,1
  1449.          AnyMail = ZTrue
  1450.          WasX = CVI(MID$(ZUserRecord$,57,2))
  1451.          WasX = (WasX AND 512) > 0
  1452.          CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse)
  1453.          InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$)
  1454.          IF InCur THEN _
  1455.             WasX = ZMailWaiting : _                                  ' KG030101
  1456.             ZWasA = ZLastMsgRead _
  1457.          ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
  1458.          ZWasB = VAL(LEFT$(ZMsgRec$,8))
  1459.          WasZ = (ZWasB - ZWasA)
  1460.          IF WasZ < 0 THEN _
  1461.             ZWasA = 0 : _
  1462.             WasZ = ZWasB _
  1463.          ELSE IF WasZ = 0 THEN _
  1464.                  WasX = ZFalse
  1465.          ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
  1466.          ZWasSL = LEN(ZOutTxt$)
  1467.          ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$
  1468.          ZWasSL = LEN(CurPre$)
  1469.          IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
  1470.             Conf$ = "MAIN" _
  1471.          ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
  1472.          ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))
  1473.          IF WasX THEN _
  1474.             WasX$ = ZEmphasizeOn$ : _
  1475.             ZWasZ$ = ZEmphasizeOff$ _
  1476.          ELSE WasX$ = "" : _
  1477.               ZWasZ$ = ""
  1478.          ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s): " + _
  1479.               WasX$ + MID$("-None-*Some*",-6 * WasX + 1,6) + " to you" + ZWasZ$
  1480.          ZSubParm = 5
  1481.          CALL TPut
  1482.          IF SkipJoinUnjoin THEN _
  1483.             CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
  1484.             GOTO 59853
  1485.          ZTurboKey = -ZTurboKeyUser
  1486.          CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse)
  1487.          IF ZNo THEN _
  1488.             GOTO 59854
  1489.          WasX$ = LEFT$(ZUserIn$(1),1)
  1490.          CALL AllCaps (WasX$)
  1491.          IF WasX$ = "J" THEN _
  1492.             ZHomeConf$ = Conf$ : _
  1493.             GOTO 59854
  1494.          IF WasX$ = "U" THEN _
  1495.             IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
  1496.                CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in") _
  1497.             ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
  1498.                  ZUserFileIndex = HoldUserFileIndex : _
  1499.                  ZSubParm = 6 : _
  1500.                  CALL FileLock : _
  1501.                  PUT 5, HoldUserFileIndex : _
  1502.                  ZSubParm = 8 : _
  1503.                  CALL FileLock : _
  1504.                  CALL QuickTPut1 ("Omitted you from " + Conf$)
  1505. 59853 IF NOT ZRet THEN _
  1506.          GOTO 59852
  1507. 59854 ZActiveUserFile$ = WasA1$
  1508.       CALL OpenUser (HighestUserRecord)
  1509.       FIELD 5, 128 AS ZUserRecord$
  1510.       IF (NOT ZRet) AND NOT AnyMail THEN _
  1511.          CALL QuickTPut1 ("You have not joined any conferences")
  1512.       ZUserFileIndex = UserFileIndexSave
  1513.       LSET ZUserRecord$ = UserRecordHold$
  1514.       ZActiveMessageFile$ = MsgFileSave$
  1515.       CALL OpenMsg
  1516.       FIELD 1, 128 AS ZMsgRec$
  1517.       GET 1,1
  1518.       ZNonStop = (ZPageLength > 0)
  1519.       END SUB
  1520. 59858 ' $SUBTITLE: 'AskMore -- pauses when possible screen full'
  1521. ' $PAGE
  1522. '
  1523. '  NAME    -- AskMore
  1524. '
  1525. '  INPUTS  --   PARAMETER     MEANING
  1526. '               ExtraPrompt$  STRING TO ADD TO MORE PROMPT AT END
  1527. '               OverWrite     WHETHER TO WIPE AWAY PROMPT
  1528. '
  1529. '  OUTPUTS --   ZUserIn$()
  1530. '               ZNo
  1531. '
  1532. '  PURPOSE -- Determines whether need to pause if screen full.
  1533. '             And, if so, asks the appropriate question.  If non-
  1534. '             stop, at least check for carrier present.
  1535. '
  1536.       SUB AskMore (ExtraPrompt$, OverWrite, CheckLines,AbortIndex,CantInterrupt) STATIC
  1537.       ZNo = ZFalse
  1538.       IF CheckLines THEN _
  1539.          WasX = -ZDisplayAsUnit*ZUnitCount -(NOT ZDisplayAsUnit)*ZLinesPrinted : _
  1540.          IF WasX < ZPageLength OR (ZPageLength = 0) THEN _
  1541.             ZWasQ = 0 : _
  1542.             EXIT SUB
  1543.       IF ZOneStop THEN _
  1544.          ZOneStop = ZFalse : _
  1545.          ZNonStop = ZTrue : _
  1546.          GOTO 59860
  1547.       IF ZNonStop THEN _
  1548.          ZLinesPrinted = 0 : _
  1549.          CALL CheckCarrier : _
  1550.          IF ZKeyboardStack$ = "" AND ZCommPortStack$ = "" THEN _
  1551.             EXIT SUB _
  1552.          ELSE ZNonStop = ZFalse
  1553. 59860 CALL QuickTPut (ZEmphasizeOff$,0)
  1554.       IF CantInterrupt THEN _
  1555.          ZTurboKey = 2 : _
  1556.          ZForceKeyboard = ZTrue : _
  1557.          ZOutTxt$ = "Press Any Key to continue" _
  1558.       ELSE GOSUB 59870 : _
  1559.            ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser)
  1560.       WasX = LEN(ZOutTxt$) + 2
  1561.       ZNoAdvance = OverWrite
  1562.       ZSubParm = 1
  1563.       IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _
  1564.          ZTurboKey = -ZTurboKeyUser
  1565.       ZMacroMin = 2
  1566.       CALL TGet
  1567.       IF ZSubParm = -1 THEN _
  1568.         EXIT SUB
  1569.       ZTurboKey = ZFalse
  1570.       ZWasDF$ = ZUserIn$ (1)
  1571.       CALL AllCaps (ZWasDF$)
  1572.       WasI = INSTR(";C;A;",";"+ZWasDF$+";")
  1573.       IF WasI = 1 THEN _
  1574.          ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _  ' Bh 112390
  1575.          ZNonStop = ZTrue : _
  1576.          ZWasQ = 0
  1577.       CALL WipeLine (WasX + LEN(ZUserIn$))
  1578.       IF NOT ZHiLiteOff THEN _
  1579.          CALL QuickTPut (ZLastSmartColor$,0)
  1580.       IF CantInterrupt THEN _
  1581.          ZNo = ZFalse : _
  1582.          EXIT SUB
  1583.       IF WasI = 3 THEN _
  1584.          AbortIndex = 32000
  1585.       IF ZNo THEN _
  1586.          ZKeyboardStack$ = "" : _
  1587.          ZCommPortStack$ = "" : _
  1588.          ZLastSmartColor$ = ""
  1589.       IF NOT ZJumpSupported THEN _
  1590.          EXIT SUB
  1591.       IF ZWasDF$ = "J" THEN _
  1592.          IF ZWasQ > 1 THEN _
  1593.             ZUserIn$ = ZUserIn$(2) : _
  1594.             GOTO 59866 _
  1595.          ELSE ZOutTxt$ = "Jump forward to what text string (one word only)" + ZPressEnterExpert$ : _ ' KG092302  ' Bh
  1596.               CALL PopCmdStack : _
  1597.               IF ZWasQ = 0 THEN _
  1598.                  EXIT SUB _
  1599.               ELSE GOTO 59866
  1600.       IF ZWasDF$ <> "R" THEN _
  1601.          EXIT SUB
  1602.       ZUserIn$ = ZJumpLast$
  1603. 59866 ZJumpTo$ = ZUserIn$
  1604.       CALL AllCaps (ZJumpTo$)
  1605.       ZJumpSearching = ZTrue
  1606.       ZJumpLast$ = ZJumpTo$
  1607.       EXIT SUB
  1608. 59870 Temp$ = ""
  1609.       IF NOT ZJumpSupported THEN _
  1610.          RETURN
  1611.       IF ZJumpLast$ = "" THEN _
  1612.          Temp$ = LEFT$(",J)ump",2+4*(ZExpertUser+1)) _
  1613.       ELSE IF ZExpertUser THEN _
  1614.               Temp$ = ",J,R=" + ZJumpLast$ _
  1615.            ELSE Temp$ = ",J)ump,R)ejump=" + ZJumpLast$
  1616.       RETURN
  1617.       END SUB
  1618. 59880 ' $SUBTITLE: 'CompDate -- subroutine to compute elased days'
  1619. ' $PAGE
  1620. '
  1621. '  NAME    -- CompDate
  1622. '
  1623. '  INPUTS  --   PARAMETER     MEANING
  1624. '                   Year        YEAR
  1625. '                   WasMM       MONTH
  1626. '                   WasDD       DAY
  1627. '                 Result!    LOCATION TO PLACE THE Result
  1628. '
  1629. '  OUTPUTS -- Result!        COMPUTE COMPUTATIONAL DATE
  1630. '
  1631. '  PURPOSE -- Computes a computational date from YEAR, MONTH, DAY.
  1632. '             Results may be used to compute the number of elapsed
  1633. '             days between two dates.  You may pass a 2 or 4 digit
  1634. '             year, but for meaningful results, be consistent
  1635. '
  1636.       SUB CompDate (Year,WasMM,WasDD,Result!) STATIC
  1637.       IF WasMM < 1 OR WasMM > 12 THEN _
  1638.          WasMM = 1
  1639.       Result! = Year * 365.0 + _
  1640.                 INT((Year - 1) / 4) + _
  1641.                 (WasMM - 1) * 28 + _
  1642.                 VAL(MID$("000303060811131619212426",(WasMM - 1) * 2 + 1,2)) - _
  1643.                 ((WasMM > 2) AND ((Year MOD 4) = 0)) + _
  1644.                 WasDD
  1645.       END SUB
  1646. 59890 ' $SUBTITLE: 'ExpireDate -- subroutine to display expiration date'
  1647. ' $PAGE
  1648. '
  1649. '  NAME    -- ExpireDate
  1650. '
  1651. '  INPUTS  --   PARAMETER           MEANING
  1652. '             RegDate!    COMPUTATIONAL REGISTRATION DATE
  1653. '             RegPeriod   DAYS IN REGISTRATION PERIOD
  1654. '
  1655. '  OUTPUTS -- ExpDate$             DISPLAYABLE EXPIRATION DATE
  1656. '
  1657. '  PURPOSE -- Computes/creates a displayable registration
  1658. '             expiration date using registration date and days in
  1659. '             registration period.
  1660. '
  1661.       SUB ExpireDate (RegDate!,RegPeriod,ExpDate$) STATIC
  1662.       ExpDate! = RegDate! + RegPeriod
  1663.       ExpireYear = INT((ExpDate! - ExpDate! / 1461) / 365)
  1664.       ExpireDay = ExpDate! - (ExpireYear * 365.0 + INT((ExpireYear -1)/4))
  1665.       ExpireMonth = -((ExpireYear MOD 4)<>0) * _
  1666.                       (1 - (ExpireDay > 31) - (ExpireDay > 59) - _
  1667.                       (ExpireDay > 90) - (ExpireDay >120) - _
  1668.                       (ExpireDay > 151) - (ExpireDay > 181) - _
  1669.                       (ExpireDay > 212) - (ExpireDay > 243) - _
  1670.                       (ExpireDay > 273) - (ExpireDay > 304) - _
  1671.                       (ExpireDay > 334)) - ((ExpireYear MOD 4) = 0) * _
  1672.                       (1 - (ExpireDay > 31) - (ExpireDay > 60) - _
  1673.                       (ExpireDay > 91) - (ExpireDay >121) - _
  1674.                       (ExpireDay > 152) - (ExpireDay > 182) - _
  1675.                       (ExpireDay > 213) - (ExpireDay > 243) - _
  1676.                       (ExpireDay > 274) - (ExpireDay > 305) - _
  1677.                       (ExpireDay > 335))
  1678.       ExpireDay = (ExpireDay - ((ExpireMonth - 1) * 28 + _
  1679.          VAL(MID$("000303060811131619212426",(ExpireMonth -1) * 2 + 1,2)))) + _
  1680.          ((ExpireMonth > 2) AND ((ExpireYear MOD 4) = 0))
  1681.       ExpDate$ = RIGHT$("0" + MID$(STR$(ExpireMonth),2),2) + _
  1682.                   "/" + _
  1683.                   RIGHT$("0" + MID$(STR$(ExpireDay),2),2) + _
  1684.                   "/" + _
  1685.                   RIGHT$(STR$(ExpireYear),2)
  1686.       END SUB
  1687. 59920 ' $SUBTITLE: 'ColorDir - builds a color FMS directory string'
  1688. ' $PAGE
  1689. '
  1690. '  NAME    --  ColorDir
  1691. '
  1692. '  INPUTS  --  PARAMETER                   MEANING
  1693. '               Strng$              String to alter
  1694. '               FMSDir$            "Y" FOR FMS DIR
  1695. '                                  "N" FOR PERSONAL Download
  1696. '
  1697.       SUB ColorDir (Strng$,FMSDir$) STATIC
  1698.       IF ZWasGR < 2 THEN _
  1699.          EXIT SUB
  1700.       IF FMSDir$ = "N" THEN _
  1701.          GOTO 59921
  1702. '
  1703. ' INSERT COLOR FOR FILENAME
  1704. '
  1705.       ON INSTR("\ *",LEFT$(Strng$,1)) GOTO 59924,59922,59923
  1706. '59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,10) + _
  1707. '               ZDR3$ + MID$(Strng$,24,10) + ZDR4$ + MID$(Strng$,34,ZMaxDescLen)
  1708. '      EXIT SUB
  1709. 59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,7) + _     ' Bh 082790
  1710.                ZDR3$ + MID$(Strng$,21,7) + ZDR4$ + MID$(Strng$,28,ZMaxDescLen)
  1711.       EXIT SUB
  1712. 59922 Strng$ = ZDR4$ + Strng$
  1713.       EXIT SUB
  1714. 59923 Strng$ = ZEmphasizeOff$ + Strng$
  1715. 59924 END SUB
  1716. 59930 ' $SUBTITLE: 'CheckColor - highlights based on search string'
  1717. ' $PAGE
  1718. '
  1719. '  NAME    --  CheckColor
  1720. '
  1721. '  INPUTS  --  PARAMETER                   MEANING
  1722. '              LookFor$           String that triggers highlight
  1723. '              LookIn$            String being searched
  1724. '              EndColor$          Terminating color
  1725. '
  1726. '  OUTPUTS --  Strng$              Revised string
  1727. '
  1728. '  PURPOSE --  Adds highlighting to a string within a string.
  1729. '              Respects previous colorization.
  1730.       SUB CheckColor (LookIn$,LookFor$,PassedEndColor$) STATIC
  1731.       IF LookFor$ = "" THEN _
  1732.          EXIT SUB
  1733.       WasX$ = LookIn$
  1734.       CALL AllCaps (WasX$)
  1735.       StartColor = INSTR(WasX$,LookFor$)
  1736.       IF StartColor < 1 THEN _
  1737.          EXIT SUB
  1738.       EndColor$ = PassedEndColor$
  1739.       IF EndColor$ = "" THEN _
  1740.          EndColor$ = ZEmphasizeOff$ : _
  1741.          CALL FindLast (LEFT$(LookIn$,StartColor-1),ZEscape$,WhereFound,WasJ) : _
  1742.          IF WhereFound > 0 THEN _
  1743.             WasJ = INSTR(WhereFound,LookIn$,"m") : _
  1744.             IF WasJ > 0 THEN _
  1745.                EndColor$ = MID$(LookIn$,WhereFound,WasJ-WhereFound+1)
  1746.       CALL Bracket (LookIn$,StartColor,StartColor + LEN(LookFor$)-1,ZEmphasizeOn$,EndColor$)
  1747.       END SUB
  1748. 59934 ' $SUBTITLE: 'SetHiLite - subroutine to reset highlight preference'
  1749. ' $PAGE
  1750. '
  1751. '  NAME    --  SetHiLite
  1752. '
  1753. '  INPUTS  --  PARAMETER                   MEANING
  1754. '              SetTo              New value (True or False)
  1755. '              ZEmphasizeOnDef$   String turns emphasize on
  1756. '              ZEmphasizeOffDef$  String turns emphasize off
  1757. '
  1758. '  OUTPUTS --  ZHiLiteOff       Callers preference on Hilite
  1759. '              ZEmphasizeOn$       String to use for emphasis
  1760. '              ZEmphasizeOff$      String to use after emphasis
  1761. '
  1762.       SUB SetHiLite (SetTo) STATIC
  1763.       ZHiLiteOff = (ZEmphasizeOnDef$ <> "" AND SetTo)
  1764.       IF ZHiLiteOff THEN _
  1765.          ZEmphasizeOn$ = "" : _
  1766.          ZEmphasizeOff$ = "" : _
  1767.          ZFG1$ = "" : _
  1768.          ZFG2$ = "" : _
  1769.          ZFG3$ = "" : _
  1770.          ZFG4$ = "" _
  1771.       ELSE ZEmphasizeOn$ = ZEmphasizeOnDef$ : _
  1772.            ZFG1$ = ZFG1Def$ : _
  1773.            ZFG2$ = ZFG2Def$ : _
  1774.            ZFG3$ = ZFG3Def$ : _
  1775.            ZFG4$ = ZFG4Def$
  1776.       END SUB
  1777. 59940 ' $SUBTITLE: 'ColorPrompt - subroutine to colorize prompts'
  1778. ' $PAGE
  1779. '
  1780. '  NAME    --  ColorPrompt
  1781. '
  1782. '  INPUTS  --  PARAMETER                   MEANING
  1783. '              Strng$              String to colorize
  1784. '              ZHiLiteOff          Whether highlighting is off
  1785. '              ZEmphasizeOn$       String to use for emphasis
  1786. '              ZEmphasizeOff$      String to use after emphasis
  1787. '
  1788. '  OUTPUTS --  Strng$              Colorized string
  1789. '
  1790. '  PURPOSE -- colorizes a string based on sysop settings
  1791. '             and the string.
  1792. '                        [...] is the default - put in emphasis
  1793. '                        <...> options to type - put in ZFG4$
  1794. '                        and first two preceeding words use ZFG1$ and ZFG2$
  1795. '                        options identified on right by ) and on
  1796. '                        left by space or comma - put in ZFG4$
  1797. '
  1798.       SUB ColorPrompt (Strng$) STATIC
  1799.       IF ZHiLiteOff THEN _
  1800.          EXIT SUB
  1801.       AlreadyColorized = (INSTR(Strng$,ZEscape$) > 0)
  1802.       WasX = INSTR(Strng$,"<")
  1803.       IF WasX > 0 THEN _
  1804.          GOTO 59943
  1805.       WasX = INSTR(Strng$,"[")   ' highlight default
  1806.       IF WasX > 0 THEN _
  1807.          WasY = INSTR(WasX,Strng$,"]") : _
  1808.          IF WasY > 0 THEN _
  1809.             CALL Bracket (Strng$,WasX,WasY,ZEmphasizeOn$,ZEmphasizeOff$)
  1810.       IF AlreadyColorized THEN _
  1811.          EXIT SUB
  1812.       WasX = INSTR(Strng$,"<")
  1813.       IF WasX < 1 THEN _
  1814.          GOTO 59945
  1815. 59943 WasY = INSTR(WasX,Strng$,">")
  1816.       IF WasY < 1 THEN _
  1817.          GOTO 59945
  1818.       CALL Bracket (Strng$,WasX,WasY,ZFG4$,ZEmphasizeOff$)
  1819.       WasY = INSTR(Strng$," ")
  1820.       IF WasY > 1 AND WasY < WasX THEN _
  1821.          Strng$ = ZFG1$ + Strng$ : _
  1822.          WasZ = INSTR(WasY+1,Strng$," ") : _
  1823.          IF WasZ > 1 AND WasZ < WasX+LEN(ZFG1$) THEN _
  1824.             Strng$ = LEFT$(Strng$,WasZ) + ZFG2Def$ + MID$(Strng$,WasZ+1)
  1825.       EXIT SUB
  1826. 59945 WasX = 1
  1827.       DidInsert = ZFalse
  1828.       WasL = LEN(ZFG4$)
  1829. 59950 WasY = INSTR (WasX,Strng$,")")  ' x: where command begins, y: terminating pos
  1830.       WasZ = INSTR (WasX,Strng$,",")
  1831.       IF WasY = 0 OR (WasZ > 0 AND WasZ < WasY) THEN _
  1832.          WasY = WasZ
  1833.       WasK = LEN(Strng$)
  1834.       IF WasX > WasK THEN _
  1835.          EXIT SUB
  1836.       IF WasY < 1 THEN _
  1837.          IF NOT DidInsert THEN _
  1838.             EXIT SUB _
  1839.          ELSE WasY = WasK+1
  1840.       WasZ = WasY - 1
  1841.       WHILE WasZ > 0    ' got terminating pos: find beginning
  1842.          IF INSTR(ZOptionEnd$,MID$(Strng$,WasZ,1)) > 0 THEN _
  1843.             WasX = WasZ + 1 : _
  1844.             WasZ = 0
  1845.          WasZ = WasZ - 1
  1846.       WEND
  1847.       IF WasY-WasX < 3 THEN _     ' exclude commands too long
  1848.          CmndString$ = MID$(Strng$,WasX,WasY-WasX) : _
  1849.          WasX$ = CmndString$ : _
  1850.          CALL AllCaps (CmndString$) : _
  1851.          IF WasX$ = CmndString$ THEN _  ' exclude lower case
  1852.             DidInsert = ZTrue : _
  1853.             CALL Bracket (Strng$,WasX,WasY-1,ZFG4$,ZEmphasizeOff$) : _  ' colorize
  1854.             WasY = WasY + WasL
  1855.       WasX = WasY + 1
  1856.       GOTO 59950
  1857.       END SUB
  1858. 59960 ' $SUBTITLE: 'Bracket - Inserts strings around a string'
  1859. ' $PAGE
  1860. '
  1861. '  NAME    --  Bracket
  1862. '
  1863. '  INPUTS  --  PARAMETER                   MEANING
  1864. '              Strng$              Insert in this string
  1865. '              B4Here              Insert 1st before this pos
  1866. '              AfterHere           Insert 2nd after this pos
  1867. '              B4String$           String to insert before
  1868. '              AfterString$        String to insert after
  1869. '
  1870. '  OUTPUTS --  Strng$
  1871. '
  1872. '  PURPOSE -- Primarily for colorization
  1873. '
  1874.       SUB Bracket (Strng$,B4Here,AfterHere,B4String$,AfterString$) STATIC
  1875.       Strng$ = LEFT$(Strng$,B4Here-1) + _
  1876.                B4String$ + _
  1877.                MID$(Strng$,B4Here,AfterHere-B4Here+1) + _
  1878.                AfterString$ + _
  1879.                RIGHT$(Strng$,LEN(Strng$) - AfterHere)
  1880.       END SUB
  1881. 59965 ' $SUBTITLE: 'UserColor - lets user set color for normal text'
  1882. ' $PAGE
  1883. '
  1884. '  NAME    --  UserColor
  1885. '
  1886. '  INPUTS  --  PARAMETER                   MEANING
  1887. '              ZEmphasizeOff$            Normal text color
  1888. '
  1889. '  OUTPUTS --  ZEmphasizeOff$            New text color
  1890. '              ZBoldText$                Whether bold (0 not, 1 bold)
  1891. '              ZUserTextColor            ANSI Color selected
  1892. '
  1893. '  PURPOSE --  Lets caller select desired color and whether bold.
  1894. '
  1895.       SUB UserColor STATIC
  1896.       IF ZHiLiteOff THEN _
  1897.          EXIT SUB
  1898. 59970 CALL QuickTPut (ZEmphasizeOff$,0)
  1899.       ZOutTxt$ = "Make text R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite" + ZPressEnterExpert$
  1900.       GOSUB 59973
  1901.       IF ZWasQ = 0 THEN _
  1902.          ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  1903.              ";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _
  1904.          EXIT SUB
  1905.       CALL AllCaps (ZUserIn$)
  1906.       WasX = INSTR("RGYBPCW",ZUserIn$)
  1907.       IF WasX = 0 THEN _
  1908.          GOTO 59970
  1909.       ZUserTextColor = 30 + WasX
  1910.       ZOutTxt$ = "Make text Bright (Y,[N])"
  1911.       GOSUB 59973
  1912.       ZBoldText$ = CHR$(48 - ZYes)
  1913.       ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  1914.       GOTO 59970
  1915. 59973 ZSubParm = 1
  1916.       ZTurboKey = -ZTurboKeyUser
  1917.       CALL TGet
  1918.       IF ZSubParm = -1 THEN _
  1919.          EXIT SUB
  1920.       RETURN
  1921.       END SUB
  1922. 59980 ' $SUBTITLE: 'SetGraphic - Sets user graphic preference'
  1923. ' $PAGE
  1924. '
  1925. '  NAME    --  SetGraphic
  1926. '
  1927. '  INPUTS  --  PARAMETER                   MEANING
  1928. '              GraphicsNumber        0=None, 1=Ascii, 2=color
  1929. '
  1930. '  OUTPUTS --  ZWasGR                Shared var - set to
  1931. '                                    graphics.number
  1932. '              GraphicsLetter$       What add to file name to
  1933. '                                see if got graphics file ver
  1934. '
  1935. '  PURPOSE --  Sets file graphics preference
  1936. '
  1937.       SUB SetGraphic (GraphicsNumber,GraphicsLetter$) STATIC
  1938.       ZWasGR = GraphicsNumber
  1939.       IF ZWasGR = 2 THEN _
  1940.          ZDR1$ = ZFG1Def$ : _
  1941.          ZDR2$ = ZFG2Def$ : _
  1942.          ZDR3$ = ZFG3Def$ : _
  1943.          ZDR4$ = ZFG4Def$ _
  1944.       ELSE ZDR1$ = "" : _
  1945.            ZDR2$ = "" : _
  1946.            ZDR3$ = "" : _
  1947.            ZDR4$ = ""
  1948.       GraphicsLetter$ = MID$(" GC",ZWasGR+1, - (ZWasGR > 0))
  1949.       END SUB
  1950. 60000 ' $SUBTITLE: 'EofComm - Determines whether input in comm port buffer'
  1951. ' $PAGE
  1952. '
  1953. '  NAME    --  EofComm
  1954. '
  1955. '  INPUTS  --  PARAMETER                   MEANING
  1956. '               ZFossil              Whether fossil driver used
  1957. '               ZComPort            Comm port # in use
  1958. '
  1959. '  OUTPUTS --  NoChars           -1 (True) if no chars in buffer.
  1960. '                                   Anything else means has char.
  1961. '
  1962. '  PURPOSE -- Query comm port to see if input waiting
  1963. '
  1964.       SUB EofComm (NoChars) STATIC
  1965.       NoChars = EOF(3)
  1966.       END SUB
  1967. 60100 ' $SUBTITLE: 'GlobalSrchRepl - Global search and replace'
  1968. ' $PAGE
  1969. '
  1970. '  NAME    --  GlobalSrchRepl
  1971. '
  1972. '  INPUTS  --  PARAMETER                   MEANING
  1973. '              Strng$              String to edit
  1974. '              LookFor$           String to look for
  1975. '              ReplaceBy$         String to replace by
  1976. '
  1977. '  OUTPUTS --  Strng$              Edited string
  1978. '
  1979. '  PURPOSE --  Replaces every occurence of LookFor$ that
  1980. '                         is in Strng$ by ReplaceBy$
  1981. '
  1982.       SUB GlobalSrchRepl (Strng$,LookFor$,ReplaceBy$,OverStrike) STATIC
  1983.       IF LookFor$ = "" THEN _
  1984.          EXIT SUB
  1985.       WasX = 1
  1986.       WasL = LEN(ReplaceBy$)
  1987.       ZMsgPtr = LEN(LookFor$)
  1988. 60102 WasY = INSTR(WasX,Strng$,LookFor$)
  1989.       IF WasY < 1 THEN _
  1990.          EXIT SUB
  1991.       IF OverStrike THEN _
  1992.          MID$(Strng$,WasY) = ReplaceBy$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  1993.       ELSE Strng$ = LEFT$(Strng$,WasY-1) + _
  1994.                     ReplaceBy$ + _
  1995.                     RIGHT$(Strng$,LEN(Strng$)-WasY+1-ZMsgPtr)
  1996.       WasX = WasY + WasL
  1997.       IF WasX > LEN(Strng$) THEN _
  1998.          EXIT SUB
  1999.       GOTO 60102
  2000.       END SUB
  2001. 60130 ' $SUBTITLE: 'MetaGSR -- Meta Global search and replace'
  2002. ' $PAGE
  2003. '
  2004. '  NAME    --  MetaGSR
  2005. '
  2006. '  INPUTS  --  PARAMETER               MEANING
  2007. '              Strng$              String to edit
  2008. '
  2009. '  OUTPUTS --  Strng$              Edited string
  2010. '
  2011. '  PURPOSE --  Global search and replace for meta variables
  2012. '
  2013.       SUB MetaGSR (Strng$,OverStrike) STATIC
  2014.       WasY = 1
  2015. 60131 IF WasY > LEN(Strng$) THEN _
  2016.          EXIT SUB
  2017.       WasX = INSTR(WasY,Strng$,"[")
  2018.       IF WasX = 0 THEN _
  2019.          EXIT SUB
  2020.       WasY = INSTR(WasX,Strng$,"]")
  2021.       IF WasY = 0 THEN _
  2022.          EXIT SUB
  2023.       ZMsgPtr = WasY-WasX+1
  2024.       Temp = WasY-WasX-1
  2025.       CALL CheckInt(MID$(Strng$,WasX+1,Temp))
  2026.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR (ZTestedIntValue > ZMaxWorkVar) THEN _
  2027.          GOTO 60135
  2028.       IF ((ZTestedIntValue < 10) AND (Temp = 1)) OR ((ZTestedIntValue > 9) AND (Temp = 2)) THEN _
  2029.          GOTO 60132
  2030.       WasY = WasX + 1
  2031.       GOTO 60131
  2032. 60132 WorkHold$ = ZGSRAra$(ZTestedIntValue)
  2033.       IF WasY = LEN(Strng$) THEN _
  2034.          GOTO 60151
  2035.       IF MID$(Strng$,WasY+1,1) <> "(" THEN _
  2036.          GOTO 60151
  2037.       WasI = INSTR(WasY+1,Strng$,")")
  2038.       IF WasI = 0 THEN _
  2039.          GOTO 60151
  2040.       WasJ = INSTR(WasY+1,Strng$,":")
  2041.       IF WasJ > WasI THEN _
  2042.          GOTO 60151
  2043.       CALL CheckInt (MID$(Strng$,WasY+2))
  2044.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  2045.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2046.             GOTO 60151
  2047.       WasY = WasI
  2048.       ZMsgPtr = WasI-WasX+1
  2049.       StartSub = ZTestedIntValue
  2050.       CALL CheckInt (MID$(Strng$,WasJ+1))
  2051.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR _
  2052.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2053.             GOTO 60151
  2054.       LenSub = ZTestedIntValue
  2055.       WorkHold$ = MID$(WorkHold$,StartSub,LenSub)
  2056.       GOTO 60151
  2057. 60135 MetaVal$ = MID$(Strng$,WasX+1,WasY-WasX-1)
  2058.       WasI = INSTR("      BAUD  PORT  PORT# PARITYPROTO NODE  FILE  ",MetaVal$)
  2059.       IF WasI = 0 OR LEN(MetaVal$) < 4 THEN _
  2060.          WasY = WasX + 1 : _
  2061.          GOTO 60131
  2062.       WasJ = (WasI-1)\6 + 1
  2063.       WasK = (WasI+4)\6 + 1
  2064.       IF WasK > WasJ THEN _
  2065.          EXIT SUB
  2066.       ON WasJ GOTO 60155, _
  2067.                 60137, _
  2068.                 60139, _
  2069.                 60141, _
  2070.                 60143, _
  2071.                 60145, _
  2072.                 60147, _
  2073.                 60149, _
  2074.                 60151
  2075. 60137 WorkHold$ = ZTalkToModemAt$
  2076.       GOTO 60151
  2077. 60139 WorkHold$ = ZComPort$
  2078.       GOTO 60151
  2079. 60141 WorkHold$ = MID$(ZComPort$,4)
  2080.       GOTO 60151
  2081. 60143 WorkHold$ = MID$(ZBaudParity$,INSTR(ZBaudParity$,",")+1,1)
  2082.       GOTO 60151
  2083. 60145 WorkHold$ = ZWasFT$
  2084.       GOTO 60151
  2085. 60147 WorkHold$ = ZNodeID$
  2086.       GOTO 60151
  2087. 60149 IF ZBatchTransfer THEN _
  2088.          WorkHold$ = "@" + ZNodeWorkFile$ _
  2089.       ELSE WorkHold$ = ZFileName$
  2090.       GOTO 60151
  2091. 60151 WasL = LEN(WorkHold$)
  2092.       IF OverStrike THEN _
  2093.          MID$(Strng$,WasX) = WorkHold$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  2094.       ELSE Strng$ = LEFT$(Strng$,WasX-1) + WorkHold$ + RIGHT$(Strng$,LEN(Strng$)-WasY)
  2095.       WasY = 1 ' WasY = WasX + WasL
  2096.       GOTO 60131
  2097. 60155 WasY = WasY + 1
  2098.       GOTO 60131
  2099.       END SUB
  2100. 60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features'
  2101. ' $PAGE
  2102. '
  2103. '  NAME    --  TimeLock  (written by Doug Azzarito)
  2104. '
  2105. '  INPUTS  --  PARAMETER                   MEANING
  2106. '              ZTimeLockSet               SECONDS/SESSION TO LOCK
  2107. '
  2108. '  OUTPUTS --  ZSubParm     -1 if feature is LOCKED
  2109. '
  2110. '  PURPOSE -- Check elapsed time for lock duration
  2111. '
  2112.       SUB TimeLock STATIC
  2113.       CALL TimeRemain(MinsRemaining)
  2114.       IF ZSecsUsedSession! >= ZTimeLockSet THEN _
  2115.          ZOK = ZTrue : _
  2116.          EXIT SUB
  2117.       ZOutTxt$ = ZFirstName$
  2118.       CALL NameCaps(ZOutTxt$)
  2119.       CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _
  2120.                    STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _
  2121.                    " more minutes" + _
  2122.                    STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds")
  2123.       CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX)
  2124.       ZOK = ZFalse
  2125.       END SUB
  2126. 60200 ' $SUBTITLE: 'MarkTime - Give feedback for lengthy processes'
  2127. ' $PAGE
  2128. '
  2129. '  NAME    --  MarkTime
  2130. '
  2131. '  INPUTS  --  PARAMETER                   MEANING
  2132. '              DotNumber          How many dots printed
  2133. '
  2134. '  OUTPUTS --  DotNumber
  2135. '
  2136. '  PURPOSE --  Marks time by putting colorized dots out
  2137. '              to 4, then erasing
  2138. '
  2139.       SUB MarkTime (DotNumber) STATIC
  2140.       TimeNow! = TIMER
  2141.       IF TimeNow! - PrevTI! < 1.0 THEN _
  2142.          EXIT SUB
  2143.       PrevTI! = TimeNow!
  2144.       IF RemoveDot AND DotNumber > 0 THEN _
  2145.          CALL QuickTPut (ZBackSpace$,0) : _
  2146.          DotNumber = DotNumber - 1 : _
  2147.          EXIT SUB
  2148.       DotNumber = DotNumber + 1
  2149.       ON DotNumber GOTO 60201,60202,60203,60204
  2150. 60201 WasX$ = ZFG1$
  2151.       RemoveDot = ZFalse
  2152.       GOTO 60205
  2153. 60202 WasX$ = ZFG2$
  2154.       GOTO 60205
  2155. 60203 WasX$ = ZFG3$
  2156.       GOTO 60205
  2157. 60204 WasX$ = ZFG4$
  2158.       RemoveDot = ZTrue
  2159. 60205 CALL QuickTPut (WasX$ + "." + ZEmphasizeOff$,0)
  2160.       END SUB
  2161. 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
  2162. ' $PAGE
  2163. '
  2164. '  NAME    --  AutoPage   'Contributed  by Gregg and Bob Snyder
  2165. '                        'and RoseMarie Siddiqui
  2166. '
  2167. '  INPUTS  --  ZAutoPageDef$  List of conditions that trigger
  2168. '                                       notification and how
  2169. '
  2170. '  OUTPUTS -- NONE
  2171. '
  2172. '  PURPOSE -- Search ZAutoPageDef$ for match on whether
  2173. '             on name, security level, whether new user.
  2174. '             Also controls whether caller notified and
  2175. '             number of times sysop has bell rung.
  2176. '             And what tune to play (if any).
  2177. '
  2178.       SUB AutoPage STATIC
  2179.       CALL FindIt (ZAutoPageDef$)
  2180.       IF NOT ZOK THEN _
  2181.          EXIT SUB
  2182.       ZErrCode = 0
  2183.       ZOK = ZFalse
  2184.       WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
  2185.          CALL ReadParms (ZWorkAra$(),4,1)
  2186.          IF ZErrCode = 0 THEN _
  2187.             ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
  2188.             IF NOT ZOK THEN _
  2189.                IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
  2190.                   ZOK = ZTrue _
  2191.                ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
  2192.                        ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
  2193.                        IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
  2194.                           IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
  2195.                              ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
  2196.                                 ZOK = ZTrue
  2197.       WEND
  2198.       CLOSE 2
  2199.       IF ZErrCode > 0 OR NOT ZOK THEN _
  2200.          ZErrCode = 0 : _
  2201.          EXIT SUB
  2202.       ZPageStatus$ = "AutoPaged!"
  2203.       IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
  2204.          ZOutTxt$ = "Telling sysop you're on..." : _
  2205.          CALL RingCaller
  2206.       ZWasB = (ZWorkAra$(4) = "")
  2207.       ZWorkAra$(5) = ""
  2208.       FOR WasI = 1 TO VAL(ZWorkAra$(3))
  2209.          IF ZWasB THEN _
  2210.             CALL LPrnt (ZBellRinger$,0) : _
  2211.          ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
  2212.       NEXT
  2213. '      IF NOT ZWasB THEN _
  2214. '         CALL RBBSPlay (ZWorkAra$(5))
  2215.       END SUB
  2216. 62520 ' $SUBTITLE: 'PutMsgAttr - subroutine to save msg. attributes'
  2217. ' $PAGE
  2218. '
  2219. '  NAME    --  PutMsgAttr
  2220. '
  2221. '  INPUTS  --  PARAMETER                   MEANING
  2222. '              ZWasQ
  2223. '              ZUserIn$
  2224. '              ZLinesInMsg
  2225. '              ZWasS
  2226. '              ZNonStop
  2227. '              ZMsgDimIndex
  2228. '
  2229. '  OUTPUTS --  ZWasSQ
  2230. '              ZWasLG$(10)
  2231. '              ZLinesInMsgSave
  2232. '              ZWasSL
  2233. '              ZNonStopSave
  2234. '              ZMsgDimIndexSave
  2235. '
  2236. '  PURPOSE --  WHEN REPLYING TO A MESSAGE THIS ROUTINE SAVES
  2237. '              THE ATTRIBUTES OF THE ORGINAL MESSAGE
  2238. '
  2239.       SUB PutMsgAttr STATIC
  2240.       ZWasSQ = ZWasQ
  2241.       ZWasLG$(10) = ZUserIn$
  2242.       ZLinesInMsgSave = ZLinesInMsg
  2243.       ZWasSL = ZWasS
  2244.       ZNonStopSave = ZNonStop
  2245.       ZMsgDimIndexSave = ZMsgDimIndex
  2246.       END SUB
  2247. 62530 ' $SUBTITLE: 'GetMsgAttr - subroutine to get msg. attributes'
  2248. ' $PAGE
  2249. '
  2250. '  NAME    --  GetMsgAttr
  2251. '
  2252. '  INPUTS  --  PARAMETER                   MEANING
  2253. '              ZWasSQ
  2254. '              ZWasLG$(10)
  2255. '              ZLinesInMsgSave
  2256. '              ZWasSL
  2257. '              ZNonStopSave
  2258. '              ZMsgDimIndexSave
  2259. '
  2260. '  OUTPUTS --  ZWasQ
  2261. '              ZUserIn$
  2262. '              LINES.IN.MESSAGESAVE
  2263. '              ZWasS
  2264. '              ZNonStop
  2265. '              ZMsgDimIndex
  2266. '              ZKillMessage
  2267. '
  2268. '  PURPOSE --  After replying to a message this routine restores
  2269. '              the attributes of the orginal message
  2270. '
  2271.       SUB GetMsgAttr STATIC
  2272.       ZWasQ = ZWasSQ
  2273.       ZUserIn$ = ZWasLG$(10)
  2274.       ZLinesInMsg = ZLinesInMsgSave
  2275.       ZWasS = ZWasSL
  2276.       ZNonStop = ZNonStopSave
  2277.       ZMsgDimIndex = ZMsgDimIndexSave
  2278.       ZKillMessage = ZFalse
  2279.       END SUB
  2280. 62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
  2281. ' $PAGE
  2282. '
  2283. '  NAME    --  RptTime
  2284. '
  2285. '  INPUTS  --  PARAMETER                   MEANING
  2286. '
  2287. '  OUTPUTS --
  2288. '
  2289. '  PURPOSE --  Tells user time used on system
  2290. '
  2291.       SUB RptTime STATIC
  2292.       CALL SkipLine (1)
  2293.       CALL GetTime
  2294.       CALL AMorPM
  2295.       Mins = (ZSessionHour * 60) + ZSessionMin
  2296.       CALL Carrier
  2297.       IF ZSubParm = -1 THEN _
  2298.          EXIT SUB
  2299.       CALL QuickTPut1 ("Now: " + DATE$ + " at " + TIME$)
  2300.       CALL QuickTPut1 ("On for" + STR$(Mins) + " mins," + _
  2301.                         STR$(ZSessionSec) + " secs")
  2302.      ' CALL Talk (7,ZOutTxt$)
  2303.       END SUB
  2304. 62600 ' $SUBTITLE: 'Protocol - Determine protocols available'
  2305. ' $PAGE
  2306. '
  2307. '  NAME    -- Protocol
  2308. '
  2309. '  INPUTS  --     PARAMETER                    MEANING
  2310. '                 ZProtoDef$                File of installed protocols
  2311. '
  2312. '  OUTPUTS -- ZTransferOption$         Prompt for protocol choice
  2313. '             ZDefaultXfer$            Letters of protocols
  2314. '             ZInternalEquiv$          Internal protocol to use
  2315. '
  2316. '  PURPOSE -- TO determine what protocols are available to user
  2317. '
  2318.       SUB Protocol STATIC
  2319.       CALL FindIt (ZProtoDef$)
  2320.       IF NOT ZOK THEN _
  2321.          ZTransferOption$ = "A)scii,X)modem,C)rcXmodem,Y)modem" : _
  2322.          ZInternalEquiv$ = "AXCY" : _
  2323.          ZDefaultXfer$ = "AXCY" : _
  2324.          GOTO 62604
  2325.       ZDefaultXfer$ = ""
  2326.       ZInternalEquiv$ = ""
  2327.       ZTransferOption$ = ""
  2328.       WasL = 0
  2329. 62602 IF EOF(2) THEN _
  2330.          GOTO 62604
  2331.       CALL ReadParms (ZWorkAra$(),13,1)
  2332.       IF ZErrCode > 0 THEN _
  2333.          EXIT SUB
  2334.       ZDefaultXfer$ = ZDefaultXfer$ + " "
  2335.       ZInternalEquiv$ = ZInternalEquiv$ + " "
  2336.       IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  2337.          GOTO 62602
  2338.       IF LEFT$(ZWorkAra$(5),1) = "R" THEN _
  2339.          IF NOT ZReliableMode THEN _
  2340.             GOTO 62602
  2341.       IF LEFT$(ZWorkAra$(3),1) = "I" THEN _
  2342.          GOTO 62603
  2343.       WasX = INSTR(ZWorkAra$(12)+" "," ")
  2344.       WasX$ = LEFT$(ZWorkAra$(12),WasX-1)
  2345.       CALL FindFile (WasX$,Found)
  2346.       IF Found THEN _
  2347.          WasX = INSTR(ZWorkAra$(13)+" "," ") : _
  2348.          WasX$ = LEFT$(ZWorkAra$(13),WasX-1) : _
  2349.          CALL FindFile (WasX$,Found)
  2350.       IF NOT Found THEN _
  2351.          GOTO 62602
  2352. 62603 MID$(ZDefaultXfer$,LEN(ZDefaultXfer$),1) = LEFT$(ZWorkAra$(1),1)
  2353.       CALL FindLast (ZWorkAra$(1),ZCrLf$,WasX,WasI)
  2354.       IF WasX > 0 AND WasX >= LEN(ZWorkAra$(1)) - 2 THEN _
  2355.          ZWorkAra$(1) = LEFT$(ZWorkAra$(1),WasX-1)
  2356.       IF (WasL + LEN(ZWorkAra$(1)) < 62) AND WasX = 0 THEN _
  2357.          ZTransferOption$ = ZTransferOption$ + "," + ZWorkAra$(1) : _
  2358.          WasL = WasL + LEN(ZWorkAra$(1)) + 1 _
  2359.       ELSE WasL = LEN(ZWorkAra$(1)) : _
  2360.            ZTransferOption$ = ZTransferOption$ + _
  2361.                               ZCrLf$ + _
  2362.                               ZWorkAra$(1)
  2363.       IF LEFT$(ZWorkAra$(3),1) = "I" AND RIGHT$(ZWorkAra$(3),1) <> "I" THEN _
  2364.          MID$(ZInternalEquiv$,LEN(ZInternalEquiv$),1) = RIGHT$(ZWorkAra$(3),1)
  2365.       GOTO 62602
  2366. 62604 IF INSTR(ZInternalEquiv$,"N") > 0 THEN _
  2367.          GOTO 62605
  2368.       IF WasX = 0 THEN _
  2369.          ZTransferOption$ = ZTransferOption$ + ",N)one" _
  2370.       ELSE ZTransferOption$ = ZTransferOption$ + ZCrLf$ + "N)one"
  2371.       ZDefaultXfer$ = ZDefaultXfer$ + "N"
  2372.       ZInternalEquiv$ = ZInternalEquiv$ + "N"
  2373. 62605 IF LEFT$(ZTransferOption$,1) = "," THEN _
  2374.          ZTransferOption$ = MID$(ZTransferOption$,2)
  2375.       IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _
  2376.          CALL QuickTPut1 ("Protocol "+ZUserXferDefault$+" unavailable.  Default reset to None") : _
  2377.          ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1)
  2378.       END SUB
  2379. 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
  2380. ' $PAGE
  2381. '
  2382. '  NAME    -- Transfer
  2383. '
  2384. '  INPUTS  --     PARAMETER                    MEANING
  2385. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2386. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2387. '              ZFileName$                NAME OF FILE FOR Transfer
  2388. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2389. '                                        TO BE USED BY KERMIT (COM1
  2390. '                                        OR COM2)
  2391. '              ZBPS                      = -1 FOR   300 BAUD
  2392. '                                        = -2 FOR   450 BAUD
  2393. '                                        = -3 FOR  1200 BAUD
  2394. '                                        = -4 FOR  2400 BAUD
  2395. '                                        = -5 FOR  4800 BAUD
  2396. '                                        = -6 FOR  9600 BAUD
  2397. '                                        = -7 FOR 19200 BAUD
  2398. '
  2399. '  OUTPUTS  -- NONE
  2400. '
  2401. '  PURPOSE -- To transfer files using external protocols
  2402. '
  2403.       SUB Transfer STATIC
  2404.       IF ZPrivateDoor THEN _
  2405.          CALL PrivDoorRtn : _
  2406.          EXIT SUB
  2407.       IF ZTransferFunction = 1 THEN _
  2408.          ZUserIn$ = ZDownTemplate$ : _
  2409.          ZWasZ$ = "send " _
  2410.       ELSE IF ZTransferFunction = 2 THEN _
  2411.               ZUserIn$ = ZUpTemplate$ : _
  2412.               ZWasZ$ = "receive "
  2413.       CALL MetaGSR (ZUserIn$,ZFalse)
  2414.       CALL QuickTPut1 ("Protocol     : "+ZProtoPrompt$)
  2415.       CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0)
  2416.       IF ZBatchTransfer THEN _
  2417.          CALL QuickTPut1 ("(BATCH)") : _
  2418.          CALL OpenWork (2,ZNodeWorkFile$) : _
  2419.          WHILE NOT EOF(2) : _
  2420.            CALL ReadAny : _
  2421.            CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
  2422.            CALL QuickTPut1 ("   "+ZWasY$+WasX$) : _
  2423.          WEND _
  2424.       ELSE CALL QuickTPut1 (ZFileNameHold$)
  2425.       IF ZAutoLogoffReq or ZAutoEnd = 1 THEN _
  2426.          CALL QuickTPut1 ("Automatic logoff will occur if the transfer is successful")       ' Bh 06/26/90
  2427.       CALL PrivDoorRtn
  2428.       END SUB
  2429. 62624 ' $SUBTITLE: 'PrivDoorRtn - subroutine to exit as a private door.'
  2430. ' $PAGE
  2431. '
  2432. '  NAME    -- PrivDoorRtn
  2433. '
  2434. '  INPUTS  --     PARAMETER                    MEANING
  2435. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2436. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2437. '                                        = 3 USER REGISTRATION PGM
  2438. '              ZUserIn$                      NAME OF FILE TO EXIT TO
  2439. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2440. '                                        TO BE USED BY KERMIT (COM1
  2441. '                                        OR COM2)
  2442. '              ZBPS                      = -1 FOR   300 BAUD
  2443. '                                        = -2 FOR   450 BAUD
  2444. '                                        = -3 FOR  1200 BAUD
  2445. '                                        = -4 FOR  2400 BAUD
  2446. '                                        = -5 FOR  4800 BAUD
  2447. '                                        = -6 FOR  9600 BAUD
  2448. '                                        = -7 FOR 19200 BAUD
  2449. '
  2450. '  OUTPUTS -- NONE
  2451. '
  2452. '  PURPOSE -- To transfer control to another program
  2453. '
  2454.       SUB PrivDoorRtn STATIC
  2455.       IF ZPrivateDoor THEN _
  2456.          GOTO 62630
  2457.       IF ZFakeXRpt THEN _
  2458.          CALL FakeXRpt (ZWasFT$)
  2459.       IF ZAdvanceProtoWrite THEN _
  2460.          CALL OpenOutW ("XFER-"+ZNodeID$+".DEF") : _
  2461.          IF ZErrCode < 1 THEN _
  2462.             CALL PrintWorkA (ZFileName$+",,"+ZWasFT$) : _
  2463.             CLOSE 2
  2464.       IF ZProtoMethod$ = "S" THEN _
  2465.          GOTO 62629
  2466. 62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1)
  2467.       IF WasX$ = "" THEN _
  2468.          EXIT SUB
  2469.       CALL FindIt (WasX$)
  2470.       IF NOT ZOK THEN _
  2471.          ZOutTxt$ = "Missing door program" : _
  2472.          CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _
  2473.          ZSnoop = ZTrue : _
  2474.          CALL LPrnt (ZOutTxt$,1) : _
  2475.          EXIT SUB
  2476.       ZOutTxt$(1) = "CLS"
  2477.       GOSUB 62633
  2478.       ZOutTxt$(2) = "ECHO" + ZOutTxt$
  2479.       ZOutTxt$(3) = ZDiskForDos$ + _
  2480.               "COMMAND /C " + _
  2481.               ZUserIn$
  2482.       ZOutTxt$(4) = ZRBBSBat$
  2483.       ZPrivateDoor = ZTrue
  2484.       CALL QuickTPut1 ("I have to run an External Program for this function and I'm a little sluggish.")
  2485.       CALL QuickTPut1 ("Please be patient and stand by...I'm not quite ready yet!")
  2486.       LOCATE 25,1
  2487.       CALL LPrnt(ZLineFeed$,0)
  2488.       CALL RBBSExit (ZOutTxt$(),4)
  2489. 62629 GOSUB 62633
  2490.      ' CLS            'PE 02/16/90
  2491.       ZOutTxt$ = ZOutTxt$ + ZCrLf$     ' Pe 02/17/90
  2492.       CALL PScrn (ZOutTxt$)
  2493.       CALL ShellExit (ZUserIn$)
  2494. 62630 IF ZPrivateDoor THEN _
  2495.          CALL RestoreCom : _
  2496.          CALL DelayTime (7 + ZBPS) : _
  2497.          CALL SetBaud : _
  2498.          CALL QuickTPut1 ("Reloading HIS BOARD software.  Please be patient.")
  2499. 62631 CALL SkipLine (2)
  2500.       LOCATE 24,1
  2501. 62632 EXIT SUB
  2502. 62633 ZOutTxt$ = STR$(ZUserSecLevel) + _
  2503.                  " " + _
  2504.                  ZActiveUserName$ + _
  2505.                  " " + _
  2506.                  ZWasCI$
  2507.       RETURN
  2508.       END SUB
  2509. 62650 ' $SUBTITLE: 'FakeXRpt - subroutine to create fake xfer report'
  2510. ' $PAGE
  2511. '
  2512. '  NAME    --  FakeXRpt
  2513. '
  2514. '  INPUTS  --  PARAMETER                   MEANING
  2515. '              ZFileNameHold$      FILE TO BE TRANSFERRED
  2516. '              ProtoUsed$          Protocol USED
  2517. '
  2518. '  OUTPUTS --  WRITES OUT Transfer FILE REPORT
  2519. '
  2520. '  PURPOSE --  External protocol drivers that do not write
  2521. '              out a standard transfer report must have one
  2522. '              provided in order for "dooring" to external
  2523. '              protocols to work properly, since this file
  2524. '              is read upon returning from an external protocol.
  2525. '
  2526.       SUB FakeXRpt (ProtoUsed$) STATIC
  2527.       CLOSE 2
  2528.       OPEN "O",2,"XFER-" + _
  2529.                  ZNodeFileID$ + _
  2530.                  ".DEF"
  2531.       PRINT #2,ZFileName$
  2532.       PRINT #2,
  2533.       PRINT #2,ProtoUsed$
  2534.       PRINT #2,"S"
  2535.       CLOSE 2
  2536.       END SUB
  2537. 62660 ' $SUBTITLE: 'SetExpert - subroutine to adjust for expert change'
  2538. ' $PAGE
  2539. '
  2540. '  NAME    --  SetExpert
  2541. '
  2542. '  INPUTS  --  PARAMETER                   MEANING
  2543. '              ZExpertUser          WHETHER IS AN EXPERT
  2544. '
  2545. '  OUTPUTS --  ZMorePrompt$         Pause prompt
  2546. '              ZPressEnter$         Prompt to press enter
  2547. '
  2548. '  PURPOSE --  Make more helpful prompt for novices and shorter
  2549. '              one for experts
  2550. '
  2551.       SUB SetExpert STATIC
  2552.       IF ZExpertUser THEN _
  2553.          ZMorePrompt$ = "More <[Y],N,C" : _                       ' Bh
  2554.          ZPressEnter$ = ZPressEnterExpert$ : _
  2555.          EXIT SUB
  2556.       ZMorePrompt$ = "More [Y]es,N)o,C)ontinuous"                   ' Bh
  2557.       ZPressEnter$ = ZPressEnterNovice$
  2558.       END SUB
  2559. 62668 ' $SUBTITLE: 'NewPassword - subroutine to get new password'
  2560. ' $PAGE
  2561. '
  2562. '  NAME    --  NewPassword
  2563. '
  2564. '  INPUTS  --  PARAMETER                   MEANING
  2565. '              Prompt$               Prompt to display
  2566. '              DisallowSpaces        Whether answer can have all spaces
  2567. '
  2568. '  OUTPUTS --  ZWasZ$                   Password
  2569. '
  2570. '  PURPOSE --  To get a new password.
  2571. '
  2572.       SUB NewPassword (Prompt$,DisallowSpaces) STATIC
  2573. 62670 ZOutTxt$ = Prompt$
  2574.       ZHidden = ZTrue
  2575.       CALL PopCmdStack
  2576.       ZHidden = ZFalse
  2577.       IF ZSubParm < 0 OR ZWasQ = 0 THEN _
  2578.          EXIT SUB
  2579.       IF LEN(ZUserIn$) > 15 THEN _
  2580.          CALL QuickTPut1 ("15 chars max") : _
  2581.          GOTO 62670
  2582.       IF INSTR(ZUserIn$,";") > 0 THEN _
  2583.          CALL QuickTPut1 ("Cannot use ';'") : _
  2584.          GOTO 62670
  2585.       IF DisallowSpaces THEN _
  2586.          IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
  2587.             CALL QuickTPut1 ("Not all blanks") : _
  2588.             GOTO 62670
  2589.       CALL AllCaps (ZUserIn$)
  2590.       ZWasZ$ = ZUserIn$
  2591.       END SUB
  2592. 63000 ' $SUBTITLE: 'TimedOut - exits based on time of day'
  2593. ' $PAGE
  2594. '
  2595. '  NAME    --  TimedOut
  2596. '
  2597. '  INPUTS  --  PARAMETER                   MEANING
  2598. '              ZRCTTYBat$
  2599. '              ZNodeRecIndex
  2600. '              ZMsgRec$
  2601. '              ZModemInitBaud$
  2602. '              ZModemGoOffHookCmnd$
  2603. '
  2604. '  OUTPUTS --  NONE
  2605. '
  2606. '  PURPOSE --  When RBBS-PC is to exit to DOS at a specific time of
  2607. '              day, this routine writes out to the file specified
  2608. '              in "ZRCTTYBat$" the one-line entry:
  2609. '                          RBBSxTM.BAT
  2610. '               WHERE "x" is the node id.
  2611. '
  2612.       SUB TimedOut STATIC
  2613.       FIELD #1,128 AS ZMsgRec$
  2614.       ZSubParm = 3
  2615.       CALL FileLock
  2616.       GET 1,ZNodeRecIndex
  2617.       WasX$ = DATE$
  2618.       CALL PackDate (WasX$,ZWasY$)
  2619.       MID$(ZMsgRec$,77,2) = ZWasY$
  2620.       'MID$(ZMsgRec$,86,5) = LEFT$(TIME$,5)
  2621.       PUT 1,ZNodeRecIndex
  2622.       ZSubParm = 2
  2623.       CALL FileLock
  2624.       CLOSE 2
  2625.       ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "TM.DEF"
  2626.       OPEN "O",2,ZFileName$
  2627.       PRINT #2,MID$(ZFileName$,3,7)
  2628.       CLOSE 2
  2629.       IF ZLocalUserMode THEN _
  2630.          EXIT SUB
  2631.       IF ZSubParm <> 7 THEN _
  2632.          ZSubParm = 4 : _
  2633.          CALL FileLock : _
  2634.          CALL OpenCom(ZModemInitBaud$,",N,8,1")
  2635.       CALL TakeOffHook
  2636.       END SUB
  2637. 64003 ' $SUBTITLE: 'AskUsers - subroutine to get registration information'
  2638. ' $PAGE
  2639. '
  2640. '  NAME    --  AskUsers  (WRITTEN BY JON MARTIN)
  2641. '
  2642. '  INPUTS  --  PARAMETER                   MEANING
  2643. '              ZFileName$           NAME OF THE FILE CONTAINING THE
  2644. '                                   SCRIPT TO BE USED WHEN ASKING
  2645. '                                   THE USER QUESTIONS.
  2646. '              ZActiveUserName$     NAME OF THE CURRENT USER
  2647. '              ZUserSecLevel        USER'S SECURITY
  2648. '              ZUpperCase           SET IF USER NEEDS UPPERCASE
  2649. '
  2650. '  OUTPUTS --  WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE
  2651. '              FILE NAME SPECIFIED AS THE First PARAMETER IN THE
  2652. '              First RECORD OF THE FILE CONTAINING THE SCRIPT TO
  2653. '              BE USED.
  2654. '              ZUserSecLevel  CAN BE RAISED OR LOWERED
  2655. '
  2656. '  PURPOSE --  Provides a sophisticated, script driven mechanism by
  2657. '              which a sysop can control the interaction with the
  2658. '              user.  Special function questionnaires include the
  2659. '              registration questionnaire and the epilog.
  2660. '
  2661.       SUB AskUsers STATIC
  2662.       ZQuestAborted = ZFalse
  2663.       ZQuestChainStarted = ZFalse
  2664.       REDIM ZOutTxt$(256)
  2665.       REDIM ZWorkAra$(ZMaxWorkVar),ZGSRAra$(ZMaxWorkVar)
  2666.       PrevAppend$ = ""
  2667. '
  2668. '
  2669. ' *  LOAD SCRIPT CONTAINING THE QUESTIONS INTO THE ZOutTxt$ DIMENSION  *
  2670. '
  2671. '
  2672. 64005 ZChatAvail = ZFalse
  2673.       QestChain = ZFalse
  2674.       LastQues = 0
  2675.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  2676.       IF NOT ZOK THEN _
  2677.          EXIT SUB
  2678.       CALL ReadParms (ZOutTxt$(),2,1)
  2679.       IF ZErrCode > 0 THEN _
  2680.          EXIT SUB
  2681.       PrevAppend$ = AppendFileName$
  2682.       AppendFileName$ = ZOutTxt$(1)
  2683.       MaxSecLevel = VAL(ZOutTxt$(2))
  2684.       WasX = INSTR(ZOutTxt$(2)," ")
  2685.       IF WasX > 0 THEN _
  2686.          IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _
  2687.             CALL QuickTPut1 ("Higher security needed for questionnaire") : _
  2688.             EXIT SUB
  2689. '
  2690. '
  2691. ' *  THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS:
  2692. ' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.
  2693. ' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY
  2694. ' *   3.  THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE
  2695. ' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6,
  2696. ' *      and requires security 5 or more to access
  2697.       ScriptIndex = 1
  2698.       ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _
  2699.                          " " + _
  2700.                          DATE$ + _
  2701.                          " " + _
  2702.                          TIME$
  2703. 64010 IF EOF(2) OR ScriptIndex > 255 THEN _
  2704.          GOTO 64100
  2705.       ScriptIndex = ScriptIndex + 1
  2706.       LINE INPUT #2,ZOutTxt$(ScriptIndex)
  2707.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  2708.          CALL AllCaps (ZOutTxt$(ScriptIndex)) : _
  2709.          CALL Trim (ZOutTxt$(ScriptIndex))
  2710.       IF ZUpperCase THEN _
  2711.          CALL AllCaps (ZOutTxt$(ScriptIndex))
  2712.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "?" THEN _
  2713.          ScriptIndex = ScriptIndex + 1 : _
  2714.          ZOutTxt$(ScriptIndex) = "!"
  2715.       GOTO 64010
  2716. '
  2717. '
  2718. ' *  PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS:
  2719. ' *
  2720. ' * First COLUMN     MEANING
  2721. ' *      :        THIS LINE IS A LABEL THAT MAY BE BRANCHED TO
  2722. ' *      !        THIS MEANS THIS IS AN ANSWER
  2723. ' *      >        THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS
  2724. ' *      *        THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER
  2725. ' *      ?        THIS MEANS THIS IS A QUESTION FOR THE USER
  2726. ' *      =        THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA
  2727. ' *      -        THIS MEANS TO LOWER THE USER'S SECURITY LEVEL
  2728. ' *      +        THIS MEANS TO RAISE THE USER'S SECURITY LEVEL
  2729. ' *      @        THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT
  2730. ' *      &        THIS MEANS TO CHAIN TO ANOTHER QUESTIONNAIRE
  2731. ' *      M        Execute specified macro
  2732. ' *      T        Turbo Key
  2733. ' *      <        Assign value to work variable
  2734. '
  2735. 64100 ScriptMax = ScriptIndex
  2736.       ScriptIndex = 1
  2737. 64110 CALL Carrier
  2738.       IF ZSubParm = -1 THEN _
  2739.          GOTO 64510
  2740.       ScriptIndex = ScriptIndex + 1
  2741.       IF ScriptIndex > ScriptMax THEN _
  2742.          GOTO 64400
  2743.       ZOutTxt$ = MID$(ZOutTxt$(ScriptIndex),2)
  2744.       WasX = ZFalse
  2745.       IF LEFT$(ZOutTxt$,3) = "/FL" THEN _
  2746.          ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _
  2747.          WasX = ZTrue
  2748.       CALL MetaGSR (ZOutTxt$,WasX)
  2749.       CALL SmartText (ZOutTxt$,ZFalse,WasX)
  2750.       WasX$ = ZOutTxt$
  2751.       ON INSTR(" :!@MT><*?=-+&",LEFT$(ZOutTxt$(ScriptIndex),1)) GOTO _
  2752.          64111, _       ' catch invalid lines
  2753.          64110, _       ' : label
  2754.          64110, _       ' ! stored answer
  2755.          64420, _       ' @ abort
  2756.          64120, _       ' M macro execute
  2757.          64430, _       ' T turbo key
  2758.          64440, _       ' > goto label
  2759.          64190, _       ' < assign value
  2760.          64450, _       ' * display line
  2761.          64113, _       ' ? prompt for answer
  2762.          64114, _       ' = conditional branch
  2763.          64460, _       ' - decrease security level
  2764.          64465, _       ' + increase security level
  2765.          64470          ' & chain
  2766. 64111 ZOutTxt$ = "Invalid line.  Column 1 is <" + LEFT$(ZOutTxt$(ScriptIndex),1)+">.  Must be: * ? = + - > @ & M T <"
  2767.       ZSubParm = 5
  2768.       CALL TPut
  2769.       GOTO 64510
  2770. 64113 LastQues = ScriptIndex  ' process ?
  2771.       GOSUB 64180
  2772.       ZSubParm = 1
  2773.       CALL TGet
  2774.       IF ZSubParm = -1 THEN _
  2775.          GOTO 64510 _
  2776.       ELSE IF ZWasQ = 0 THEN _
  2777.               ZOutTxt$ = WasX$ : _
  2778.               GOTO 64113 _
  2779.            ELSE ZOutTxt$(ScriptIndex + 1) = "!" + _
  2780.                                        ZUserIn$ : _
  2781.                 ZGSRAra$(ZTestedIntValue) = ZUserIn$
  2782.       GOTO 64110
  2783. 64114 IF LEFT$(ZOutTxt$(ScriptIndex),2) = "=#" THEN _        ' Numeric
  2784.          GOSUB 64350 : _
  2785.          GOTO 64110
  2786.       GOSUB 64300             ' process =
  2787.       GOTO 64445
  2788. 64120 ZWasZ$ = MID$(ZOutTxt$(ScriptIndex),2)   ' Execute macro
  2789.       CALL Trim (ZWasZ$)
  2790.       CALL Macro (ZWasZ$,Found)
  2791.       IF Found THEN _
  2792.           CALL FDMACEXE
  2793.       GOTO 64110
  2794. 64180 CALL CheckInt (ZOutTxt$)
  2795.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  2796.           (ZTestedIntValue > ZMaxWorkVar) OR _
  2797.           (INSTR("123456789",LEFT$(ZOutTxt$,1)) = 0) THEN _
  2798.              ZTestedIntValue = 0 _
  2799.       ELSE ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-1+(ZTestedIntValue > 9))
  2800.       RETURN
  2801. 64190 GOSUB 64180
  2802.       IF ZTestedIntValue > 0 THEN _
  2803.          ZGSRAra$(ZTestedIntValue) = MID$(ZOutTxt$,2)
  2804.       GOTO 64110
  2805. '
  2806. '
  2807. ' *  SEARCH FOR GOTO LABEL
  2808. '
  2809. '
  2810. 64200 ScriptIndex = 1
  2811.       CALL MetaGSR (BranchLabel$,ZFalse)
  2812.       CALL SmartText (BranchLabel$,ZFalse,ZFalse)
  2813.       CALL AllCaps (BranchLabel$)
  2814.       CALL Trim (BranchLabel$)
  2815. 64210 ScriptIndex = ScriptIndex + 1
  2816.       IF ScriptIndex > ScriptMax THEN _
  2817.          ZOutTxt$ = BranchLabel$ + _
  2818.               " not found!" : _
  2819.          ZSubParm = 5 : _
  2820.          CALL TPut : _
  2821.          IF ZSubParm = -1 THEN _
  2822.             RETURN _
  2823.          ELSE IF LastQues > 0 THEN _
  2824.                  ScriptIndex = LastQues - 1 : _
  2825.                  RETURN _
  2826.               ELSE GOTO 64510
  2827.       IF LEFT$(ZOutTxt$(ScriptIndex),1) <> ":" THEN _
  2828.          GOTO 64210
  2829.       IF MID$(ZOutTxt$(ScriptIndex),2) <> BranchLabel$ THEN _
  2830.          GOTO 64210
  2831.       RETURN
  2832. '
  2833. '
  2834. ' *  DETERMINE BRANCH LOGIC
  2835. '
  2836. '
  2837. 64300 CurEquals = 1
  2838.       ZWasZ$ = RIGHT$(ZOutTxt$(LastQues + 1),1)
  2839.       CALL AllCaps (ZWasZ$)
  2840. 64310 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  2841.       IF NextEquals = 0 THEN _
  2842.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  2843.          GOTO 64320
  2844.       IF ZWasZ$ <> _
  2845.          MID$(ZOutTxt$(ScriptIndex),CurEquals + 1,1) THEN  _
  2846.          CurEquals = NextEquals : _
  2847.          GOTO 64310
  2848.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  2849. 64320 GOSUB 64200
  2850.       RETURN
  2851. '
  2852. '
  2853. ' *  DETERMINE Numeric BRANCH LOGIC
  2854. '
  2855. '
  2856. 64350 CurEquals = 1
  2857. 64360 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  2858.       IF NextEquals = 0 THEN _
  2859.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  2860.          GOTO 64380
  2861.       Numeric = ZTrue
  2862.       LoopIndex = 2
  2863.       WHILE LoopIndex < LEN(ZOutTxt$(ScriptIndex - 1)) +1
  2864.          IF INSTR("()1234567890- ",MID$(ZOutTxt$(ScriptIndex - 1),LoopIndex,1)) THEN _
  2865.             GOTO 64370
  2866.          Numeric = ZFalse
  2867. 64370    LoopIndex = LoopIndex + 1
  2868.       WEND
  2869.       IF NOT Numeric THEN _
  2870.          CurEquals = NextEquals : _
  2871.          GOTO 64360
  2872.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  2873. 64380 GOSUB 64200
  2874.       RETURN
  2875. '
  2876. '
  2877. ' *  WRITE RESPONSES TO DESIGNATED FILE
  2878. '
  2879. '
  2880. 64400 ScriptIndex = 0
  2881.       ZWasEN$ = AppendFileName$
  2882.       CALL LockAppend
  2883.       IF ZErrCode <> 0 THEN _
  2884.          ZOutTxt$ = "Fatal Error in script!" : _
  2885.          ZSubParm = 5 : _
  2886.          CALL TPut : _
  2887.          GOTO 64500
  2888. 64410 ScriptIndex = ScriptIndex + 1
  2889.       IF ScriptIndex > ScriptMax THEN _
  2890.          GOTO 64500
  2891.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  2892.          QuestionSave$ = MID$(ZOutTxt$(ScriptIndex),2) : _
  2893.          GOTO 64410
  2894.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" AND _
  2895.          LEN(ZOutTxt$(ScriptIndex)) < 2 THEN _
  2896.          GOTO 64410
  2897.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" THEN _
  2898.          CALL PrintWorkA (QuestionSave$) : _
  2899.          CALL PrintWorkA (MID$(ZOutTxt$(ScriptIndex),2))
  2900.       IF ScriptIndex = 1 AND _
  2901.          AppendFileName$ <> PrevAppend$ THEN _
  2902.          CALL PrintWorkA (ZOutTxt$(ScriptIndex))
  2903.       IF ZErrCode <> 0 THEN _
  2904.          ZOutTxt$ = "Unrecoverable failure in script!" : _
  2905.          ZSubParm = 5 : _
  2906.          CALL TPut : _
  2907.          GOTO 64500
  2908.       GOTO 64410
  2909. 64420 ZQuestAborted = ZTrue  ' @ abort
  2910.       GOTO 64510
  2911. 64430 ZTurboKey = -ZTurboKeyUser   ' T turbo key
  2912.       GOTO 64110
  2913. 64440 BranchLabel$ = ZOutTxt$            ' = branch
  2914.       GOSUB 64200
  2915. 64445 IF ZSubParm = -1 THEN _
  2916.          GOTO 64510 _
  2917.       ELSE GOTO 64110
  2918. 64450 ZSubParm = 5      ' * display
  2919.       CALL TPut
  2920.       GOTO 64445
  2921. 64460 WasX = -1        ' - lower security
  2922. 64462 CALL CheckInt (ZOutTxt$)
  2923.       IF ZErrCode = 0 THEN _
  2924.          Temp = ZUserSecLevel + _
  2925.             WasX * ZTestedIntValue : _
  2926.          IF Temp <= MaxSecLevel THEN _
  2927.             ZUserSecLevel = Temp : _
  2928.             ZUserSecSave = ZUserSecLevel : _
  2929.             ZAdjustedSecurity = ZTrue
  2930.       GOTO 64110
  2931. 64465 WasX = 1               ' + raise security
  2932.       GOTO 64462
  2933. 64470 QestChain = ZTrue  ' & chain questionnaires
  2934.       ZFileNameHold$ = ZOutTxt$
  2935.       GOTO 64110
  2936. 64500 CALL UnLockAppend
  2937.       CALL Carrier
  2938.       IF QestChain THEN _
  2939.          ZQuestChainStarted = ZTrue : _
  2940.          ZFileName$ = ZFileNameHold$ : _
  2941.          GOTO 64005
  2942. 64510 ZChatAvail = (INSTR("MUF",ZActiveMenu$) > 0)
  2943.       ZOK = ZTrue
  2944.       ZLastIndex = 0
  2945.       END SUB
  2946. 64600 ' $SUBTITLE: 'ViewArc - subroutine to display .ARC contents'
  2947. ' $PAGE
  2948. '
  2949. '  NAME    --  ViewArc  (Written by Jon Martin)
  2950. '
  2951. '  INPUTS  --  PARAMETER                   MEANING
  2952. '              ZFileName$           NAME OF THE ARC FILE TO BE
  2953. '                                   VIEWED.
  2954. '
  2955. '  OUTPUTS --  NONE
  2956. '
  2957. '  PURPOSE --  Provides a mechanism to provide users with the
  2958. '              contents of a libraried file prior to downloading.
  2959. '
  2960.       SUB ViewArc STATIC
  2961.       CLOSE 2
  2962.       RetCode = 0
  2963. 'Maple Street Zip View Mods ***********
  2964. IF ZLastExt$ = "ZIP" THEN _
  2965.    FilName$ = ZLibArcPath$+"PKUNZIP.EXE" _    'PE/03/28/89
  2966. ELSE IF ZLastExt$ = "LZH" THEN _
  2967. FilName$ = ZLibArcPath$+"LHARC.EXE"_  
  2968. ELSE IF ZLastExt$ = "ARC" THEN _              ' Bh 110690
  2969. FilName$ = ZLibArcPath$+"ARCVIEW.COM"_          ' Bh 110690
  2970. ELSE _
  2971.   FilName$ = ZLibArcPath$+"TYPE"            ' Bh 110690
  2972.  CALL FindIt (FilName$)
  2973.  IF NOT ZOK THEN _
  2974.   CALL QuickTPut(" Missing "+ FilName$ + " ...Please tell Sysop " ,1) : _
  2975.  EXIT SUB
  2976. CALL QuickTPut ("Preparing " + ZFileNameHold$ + " for view...one moment please.... ",1)  ' Bh 110690
  2977. '
  2978. 'CALL QuickTPut ("Creating View file, One Moment Please.... ",1)  ' Bh 110690
  2979. 'ZStopInterrupts = ZTrue
  2980. IF ZLastExt$ = "ZIP" THEN _
  2981.    SHOWARC$ = ZLibArcPath$+ "PKUNZIP.EXE -v "_
  2982. ELSE IF ZLastExt$ = "LZH" THEN _                 'PM 07/26/89
  2983.    SHOWARC$ = ZLibArcPath$+ "LHARC.EXE l "_               'PE 09/20/89
  2984. ELSE IF ZLastExt$ = "ARC" THEN _                 ' Bh 110690
  2985.    SHOWARC$ = ZLibArcPath$+ "ARCVIEW.COM "_               ' Bh 110690
  2986.  ELSE _
  2987.     SHOWARC$ = "TYPE "             ' Bh 110690
  2988. '
  2989. SHOWARC$ = SHOWARC$ +ZFileName$ + ">" + ZArcWork$
  2990.  SHELL SHOWARC$
  2991.  CALL BufFile (ZArcWork$,WasX)
  2992.  EXIT SUB
  2993.  END SUB
  2994.